{-# LANGUAGE FlexibleContexts, RecordWildCards #-}

module Control.TSession.Happstack 
  ( atomicTransactionPart
  , createTransaction
  , readVal
  , safeLoadVal
  , writeVal
  , setStatus
  , getStatus
  , getReadSet
  , commit
  , finishSession
  , TouchedValue(..)
  , TouchedValues(..)
  , TransactionBase(..)
  , Trans(..)
  , TSessionId
  )
where

import qualified Control.TSession as TS (atomicTransactionPart)
import Control.TSession hiding (atomicTransactionPart)
import Happstack.Server
import Control.Monad
import Control.Monad.IO.Class
import Control.Applicative
import Data.IORef
import Data.Tuple

atomicTransactionPart
  :: (Ord k, Eq v, MonadIO m,
      Functor m, HasRqData m, FilterMonad Response m, MonadPlus m) 
    => TransactionBase k v status 
    -> Trans k v status a -> m a
atomicTransactionPart = TS.atomicTransactionPart tsessionIdFromCookie

tsessionIdFromCookie 
  :: (MonadIO m, MonadPlus m, Functor m, 
      HasRqData m, FilterMonad Response m) 
    => TransactionBase k v status 
    -> m TSessionId
tsessionIdFromCookie tr@TransactionBase{..} = 
  msum [ transactionIdFromCookie tr
 -- My Haskell brain just exploded:
 -- http://intoscience.blogspot.de/2012/12/my-haskell-brain-just-exploded.html
       , case _tsessionIdGenerator of
          TSessionIdGenerator{..} -> do
            nextTsessionId <- liftIO $ 
              atomicModifyIORef _tsessionIdGeneratorRef (swap._tsessionIdGeneratorGenFun)
            addCookie Session $ 
              mkCookie ("transation_" ++ _trBaseName) $ 
                show nextTsessionId
            return nextTsessionId 
       ]

transactionIdFromCookie 
  :: (Monad m, Functor m, HasRqData m) 
    => TransactionBase k v status 
    -> m TSessionId
transactionIdFromCookie tr@TransactionBase{..} = do
  transactionId <- 
    read <$> lookCookieValue ("transation_" ++ _trBaseName)
  return transactionId

transactionIdFromCookieMaybe 
  :: (MonadPlus m, Functor m, HasRqData m) 
    => TransactionBase k v status 
    -> m (Maybe TSessionId)
transactionIdFromCookieMaybe tr@TransactionBase{..} = do
  msum [ Just . read <$> lookCookieValue
                           ("transation_" ++ _trBaseName)
       , return Nothing ]