content: {-# LANGUAGE  UndecidableInstances
               , TypeSynonymInstances
               , MultiParamTypeClasses
               , DeriveDataTypeable
               , FlexibleInstances #-}
  
  {- | Instantiation of the "MFlow" server for the Hack interface
  
  see <http://hackage.haskell.org/package/hack>
  -}
  
  module MFlow.Hack(
       module MFlow.Cookies
      ,module MFlow
      ,hackMessageFlow)
  where
  
  import Data.Typeable
  import Hack
  
  import Control.Concurrent.MVar(modifyMVar_, readMVar)
  import Control.Monad(when)
  
  
  import Data.ByteString.Lazy.Char8 as B(pack, unpack, length, ByteString)
  import Control.Concurrent(ThreadId(..))
  import System.IO.Unsafe
  import Control.Concurrent.MVar
  import Control.Concurrent
  import Control.Exception
  import qualified Data.Map as M
  import Data.Maybe
  import Data.TCache
  import Data.TCache.DefaultPersistence
  import Control.Workflow hiding (Indexable(..))
  
  import MFlow
  import MFlow.Cookies
  
  import MFlow.Hack.Response
  import Data.Monoid
  import Data.CaseInsensitive
  import System.Time
  
  import System.Time
  
  
  flow=  "flow"
  
  instance Processable Env  where
     pwfname  env=  if null sc then noScript else sc
        where
        sc=  tail $ pathInfo env
     puser env = fromMaybe anonymous $ lookup  cookieuser $ http env
  
     pind env= fromMaybe (error ": No FlowID") $ lookup flow $ http env
     getParams=  http
  --   getServer env= serverName env
  --   getPath env= pathInfo env
  --   getPort env= serverPort env
  
  
  
  ---------------------------------------------
  
  
  
  --
  --instance ConvertTo String TResp  where
  --      convert = TResp . pack
  --
  --instance ConvertTo ByteString TResp  where
  --      convert = TResp
  --
  --
  --instance ConvertTo Error TResp where
  --     convert (Error e)= TResp . pack  $ errorResponse e
  --
  --instance ToResponse v =>ConvertTo (HttpData v) TResp where
  --    convert= TRespR
  
  
  --webScheduler   :: Env
  --               -> ProcList
  --               -> IO (TResp, ThreadId)
  --webScheduler = msgScheduler
  
  --theDir= unsafePerformIO getCurrentDirectory
  
  wFMiddleware :: (Env -> Bool) -> (Env-> IO Response) ->   (Env -> IO Response)
  wFMiddleware filter f = \ env ->  if filter env then hackMessageFlow env    else f env -- !> "new message"
  
  -- | An instance of the abstract "MFlow" scheduler to the Hack interface
  -- it accept the list of processes being scheduled and return a hack handler
  --
  -- Example:
  --
  -- @main= do
  --
  --   putStrLn $ options messageFlows
  --   'run' 80 $ 'hackMessageFlow'  messageFlows
  --   where
  --   messageFlows=  [(\"main\",  'runFlow' flowname )
  --                  ,(\"hello\", 'stateless' statelesproc)
  --                  ,(\"trans\", 'transient' $ runflow transientflow]
  --   options msgs= \"in the browser choose\\n\\n\" ++
  --     concat [ "http:\/\/server\/"++ i ++ "\n" | (i,_) \<- msgs]
  -- @
  --hackMessageFlow :: [(String, (Token -> Workflow IO ()))]
  --                -> (Env -> IO Response)
  --hackMessageFlow  messageFlows =
  -- unsafePerformIO (addMessageFlows messageFlows) `seq`
  -- hackWorkflow -- wFMiddleware f   other
  -- where
  -- f env = unsafePerformIO $ do
  --    paths <- getMessageFlows >>=
  --    return (pwfname env `elem` paths)
  
  -- other= (\env -> defaultResponse $  "options: " ++ opts)
  -- (paths,_)= unzip messageFlows
  -- opts= concatMap  (\s -> "<a href=\""++ s ++"\">"++s ++"</a>, ") paths
  
  
  splitPath ""= ("","","")
  splitPath str=
         let
              strr= reverse str
              (ext, rest)= span (/= '.') strr
              (mod, path)= span(/='/') $ tail rest
         in   (tail $ reverse path, reverse mod, reverse ext)
  
  
  
  hackMessageFlow  ::  Env ->  IO Response
  hackMessageFlow req1=   do
       let httpreq1= http  req1
       let cookies= {-# SCC "getCookies" #-} getCookies  httpreq1
  
       (flowval , retcookies) <-  case lookup ( flow) cookies of
                Just fl -> return  (fl, [])
                Nothing  -> do
                       fl <- newFlow
                       return ( fl,  [( flow,  fl,  "/",(Just $ show $ 365*24*60*60))])
  
  {-  for state persistence in cookies
       putStateCookie req1 cookies
       let retcookies= case getStateCookie req1 of
                                  Nothing -> retcookies1
                                  Just ck -> ck:retcookies1
  -}
  
       let input=
             case  ( requestMethod req1, lookup  "Content-Type" httpreq1 )  of
                (POST,Just "application/x-www-form-urlencoded") -> urlDecode . unpack $ hackInput  req1
                (GET, _) -> urlDecode . queryString $ req1
                _ -> []
  
       let req = case retcookies of
            [] -> req1{http=  (input ++ cookies) ++ http req1}   -- !> "REQ"
            _  -> req1{http=(flow, flowval): ( input ++ cookies ) ++ http req1}   -- !> "REQ"
  
  
       (resp',th) <- msgScheduler  req
  
  
       let resp''= toResponse resp'
       let headers1= case retcookies of [] -> headers resp''; _ ->   (cookieHeaders retcookies)
       let resp =   resp''{status=200, headers= headers1 {-,("Content-Length",show $ B.length x) -}}
  
       return resp
  
  
  ------persistent state in cookies (not tested)
  
  tvresources ::  MVar (Maybe ( M.Map string string))
  tvresources= unsafePerformIO $ newMVar  Nothing
  statCookieName= "stat"
  
  putStateCookie req cookies=
      case lookup statCookieName cookies of
          Nothing -> return ()
          Just (statCookieName,  str , "/", _) -> modifyMVar_ tvresources $
                            \mmap -> case mmap of
                                Just map ->  return $ Just $ M.insert (keyResource req)  str map
                                Nothing   -> return $ Just $ M.fromList [((keyResource req),  str) ]
  
  getStateCookie req= do
      mr<- readMVar tvresources
      case mr of
       Nothing  ->  return Nothing
       Just map -> case  M.lookup (keyResource req) map  of
        Nothing -> return Nothing
        Just str -> do
          swapMVar tvresources Nothing
          return $  Just  (statCookieName,  str , "/")
  
  {-
  persistInCookies= setPersist  PersistStat{readStat=readResource, writeStat=writeResource, deleteStat=deleteResource}
      where
      writeResource stat= modifyMVar_ tvresources $  \mmap ->
                                        case mmap of
                                              Just map-> return $ Just $ M.insert (keyResource stat) (serialize stat) map
                                              Nothing -> return $ Just $ M.fromList [((keyResource stat),   (serialize stat)) ]
      readResource stat= do
             mstr <- withMVar tvresources $ \mmap ->
                                  case mmap of
                                     Just map -> return $ M.lookup (keyResource stat) map
                                     Nothing -> return  Nothing
             case mstr of
               Nothing -> return Nothing
               Just str -> return $ deserialize str
  
      deleteResource stat= modifyMVar_ tvresources $  \mmap->
                                case mmap of
                                    Just map -> return $ Just $ M.delete  (keyResource stat) map
                                    Nothing ->  return $ Nothing
  
  -}
  