module WASH.CGI.Persistent2 (T, init, get, set, add, current) where
import WASH.CGI.CGIConfig
import System
import Prelude hiding (init)
import qualified Prelude (init)
import List hiding (init)
import qualified List (init)
import Maybe
import IO
import Directory
import Monad
import Random
import WASH.Utility.Auxiliary
import WASH.CGI.CGI hiding (head, div, span, map)
import WASH.CGI.BaseCombinators (unsafe_io)
import WASH.CGI.Types
import qualified WASH.Utility.Locking as L
import WASH.CGI.StateItem
import WASH.CGI.MakeTypedName
init :: (Read a, Show a, Types a) => String -> a -> CGI (T a)
get :: (Read a, Types a) => T a -> CGI a
set :: (Read a, Show a, Types a) => T a -> a -> CGI (Maybe (T a))
add :: (Read a, Show a, Types a) => T [a] -> a -> CGI (T [a])
current :: (Read a, Types a) => T a -> CGI (Maybe (T a))
data P a = P { nr :: Int, vl :: a }
deriving (Read, Show)
t :: String -> P a -> T a
t name (P i a) = T name i
traceInit =
return ()
trace s =
return ()
init name val = do
unsafe_io $
assertDirectoryExists (List.init persistent2Dir) (return ())
io $ catch (
do traceInit
trace ("P2: init " ++ name ++ " " ++ show val)
trace ("P2: ty = " ++ show myTyspec)
trace ("P2: tid ty = " ++ tid myTyspec "")
trace ("P2: typedName = " ++ typedName)
trace ("P2: fileName = " ++ show fileName)
L.obtainLock fileName
trace ("P2.init: after obtainLock ")
contents <- readFileStrictly fileName
trace ("P2.init: after readFileStrictly " ++ contents)
L.releaseLock fileName
trace ("P2.init: after releaseLock[1] " ++ contents)
pairs <- return $ read contents
return $ t name $ head $ pairs
)
$ \ ioError ->
do trace ("P2.init: ioError caught")
nonce <- randomIO
let initialP = P nonce val
writeFile fileName (show [initialP])
trace ("P2.init: writing " ++ show [initialP])
L.releaseLock fileName
return (t name initialP)
where
fileName = persistent2Dir ++ typedName
myTyspec = ty val
typedName = makeTypedName name myTyspec
get tn@(T name i) =
unsafe_io $
do trace ("P2: get " ++ name ++ " " ++ show i)
L.obtainLock fileName
contents <- readFileStrictly fileName
L.releaseLock fileName
trace ("P2.get: fileName = " ++ show fileName)
pairs <- return $ read contents
return $ vl $ fromJust $ find ((== i) . nr) pairs
where
typedName = makeTypedNameFromVal name (tvirtual tn)
fileName = persistent2Dir ++ typedName
set (T name i) val =
io $
do trace ("P2: set " ++ name ++ " " ++ show i ++ " " ++ show val)
L.obtainLock fileName
contents <- readFileStrictly fileName
pairs <- return $ read contents
i' <- randomIO
if nr (head pairs) == i
then do writeFile fileName (show (P i' val : take 15 pairs))
L.releaseLock fileName
return (Just (T name i'))
else do L.releaseLock fileName
return Nothing
where
typedName = makeTypedNameFromVal name val
fileName = persistent2Dir ++ typedName
add (T name _) val =
io $
do trace ("P2: add " ++ name ++ " " ++ show val)
L.obtainLock fileName
contents <- readFileStrictly fileName
pairs <- return $ read contents
let P i vals = head pairs
i' <- randomIO
writeFile fileName (show (P i' (val : vals) : take 15 pairs))
L.releaseLock fileName
return (T name i')
where
typedName = makeTypedNameFromVal name [val]
fileName = persistent2Dir ++ typedName
current tn@(T name i) =
io $
do trace ("P2: current " ++ name ++ " " ++ show i)
L.obtainLock fileName
contents <- readFileStrictly fileName
L.releaseLock fileName
pairs <- return $ read contents
let P i' vals = head pairs
if i==i'
then return Nothing
else return (Just (t name (head pairs)))
where
typedName = makeTypedNameFromVal name (tvirtual tn)
fileName = persistent2Dir ++ typedName