content: {-# LANGUAGE DeriveDataTypeable,FlexibleInstances, UndecidableInstances, OverloadedStrings, TransformListComp, MonadComprehensions #-}
  import MFlow.Wai.Blaze.Html.All hiding (select)
  import Data.Typeable
  import Control.Monad
  import Data.Time
  import Data.Monoid
  import MFlow.Forms.Internals
  import Control.Monad.State
  import Data.IORef
  import Control.Workflow (exec1)
  import Debug.Trace
  import Data.TCache.Memoization
  import System.IO.Unsafe
  import Data.TCache.DefaultPersistence
  import Data.TCache.IndexQuery
  import Data.RefSerialize hiding ((<|>),empty)
  import Data.ByteString.Char8 as B(pack)
  
  --(!>)= flip trace
  
  
  
  main = runNavigation "" . step $ urlShortener
  
  data ShortUrl= ShortUrl{url :: String,  indexUrl :: Int} deriving (Read, Show, Typeable)
  
  instance Indexable ShortUrl where key ShortUrl{url= u}= makeKey u
  
  makeKey url= map subst url
    where
    subst '/'= '-'
    subst x = x
  
  newtype MaxIndex= MaxIndex Int deriving (Typeable, Read, Show)
  
  instance Indexable MaxIndex where key= const "maxIndex"
  
  instance (Read a, Show a) => Serializable a where
     serialize= runW . showp
     deserialize= runR readp
  
  refMaxIndex= getDBRef "maxIndex"
  
  urlShortener= (once >> redirect) <|> (retry1 >> newEntry)
  
  once= modify $ \s -> s{newAsk=False}
  
  noRetry= modify (\s -> s{inSync=False,newAsk=False}) >> empty
  
  retry1 = modify $ \s -> s{newAsk=True}
  
  redirect :: FlowM Html IO ()
  redirect= page $ restp >>= findUrl
   where
   findUrl :: Int -> View Html IO ()
   findUrl ind= do
   murl <- liftIO . atomically . select url $ indexUrl .==. ind
   case murl of
    []    -> noRetry !> "noRetry"
    [url] -> do
       setHttpHeader "HTTP/1.1 301 Moved Permanently" ""  !> "ok"
       setHttpHeader "Location" $ B.pack url
       return ()
  
  newEntry= page $ do
   liftIO $ index indexUrl  !> "newEntry"
   ind <-  do
      url <- getString Nothing <** submitButton "ok" <++ br <|> empty
      liftIO . atomically $ do
         let refUrl= getDBRef $ makeKey url
         found <- readDBRef refUrl
         case found of
          Nothing -> do
              MaxIndex max <- readDBRef refMaxIndex
                               `onNothing` return (MaxIndex 0)
              let max1= max + 1
              writeDBRef refUrl $ ShortUrl url max1
              writeDBRef refMaxIndex $ MaxIndex max1
              return max1
          Just (ShortUrl _ ind) -> return ind
   wlink ind   << b << (mydomain <> "/" <> show ind)
   empty
  
  mydomain= "http://localhost"
  
  --onEmpty mx my = do
  --   r <- mx
  --   if r /= empty then return r
  --   else my
  
  --errorPage= "this short URL is not in the DB" ++> empty
  
  --hideShow w= do
  --  id <- genNewId
  --  requires[onclick]
  --  div ! onClick ("onclick("++id++")")
  --  where
  --  onclick= "function(id){
  --    var elem= document.getElementById('html element id');
  --    if(elem.style.visibility ='visible')
  --       {elem.style.visibility = 'hidden'}
  --    else{elem.style.visibility = 'visible'}
  
  
  --ifInvalid w w'= View $ do
  --    r@(FormElm _ v) <- runView w
  --    case v of
  --      Nothing -> runView w'
  --      _ -> return r
  --
  --swchLink  v w= do
  --  r <- restp
  --  case r of
  --   v -> wlink ('n':v) w !> "y"
  --   ('n':v) -> wlink v w !> "n" >> empty
  -- `ifInvalid` wlink v w
  --
  