kibro 0.4.1 → 0.4.2

raw patch · 3 files changed

+40/−30 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• executable/Main.hs +1/−1
• kibro.cabal +3/−3
• library/Kibro.hs +36/−26

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, PostfixOperators #-}  ------------------------------------------------------------------------------ -- Main Kibro executable

@@ -1,5 +1,5 @@ name:          kibro-version:       0.4.1+version:       0.4.2 synopsis:      Web development framework. description:   Web development framework. category:      Web@@ -12,12 +12,12 @@ cabal-Version: >= 1.2  library-   build-depends: base,mtl,regex-compat,regexpr,random,safe,xhtml,containers,fastcgi,cgi,data-default+   build-depends: base==3.*,mtl,regex-compat,regexpr,random,safe,xhtml,containers,fastcgi,cgi,data-default    exposed-modules: Kibro    hs-source-dirs: library/    GHC-Prof-options: -auto-all  executable kibro   main-is: Main.hs-  build-depends: base,filepath,directory,haskell98,process,strict,unix,ConfigFile+  build-depends: base==3.*,filepath,directory,haskell98,process,strict,unix,ConfigFile   hs-source-dirs: executable/

@@ -25,6 +25,7 @@     , stylesheet     , (<<$)     , PageAssign+    , ahref       -- * Module re-exports     , module Network.CGI)  where@@ -51,7 +52,7 @@ import Text.XHtml.Strict  ------------------------------------------------------------------------------ Server start up+-- Server start up   -- | Same as startKibro', but with value as () and uses forkIO to fork startKibro :: [PageAssign ()] -> IO ()@@ -78,12 +79,12 @@   (_,sessions) <- liftIO $ readMVar var   (params,page) <- lift $ pageMatch ps <$> fromMaybe "" <$> getVar "REQUEST_URI"   session <- getSession-  (session',result) <- lift $ runKibro page (KibroSt session params value)-  updateSession session'+  (session',result) <- lift $ runKibro page (KibroSt session params value var)+  maybe (return ()) updateSession session'   return result  -- | Run a Kibro action, returning the new session and result-runKibro :: Kibro v CGIResult -> KibroSt v -> CGI (Session,CGIResult)+runKibro :: Kibro v CGIResult -> KibroSt v -> CGI (Maybe Session,CGIResult) runKibro p st = evalStateT (unKibro (getSess p)) st where     getSess a = do r <- a                    ss <- gets session@@ -117,6 +118,7 @@     { sessId     :: Integer     , sessValues :: Map String String     } deriving (Eq,Show)+sessionName = "KIBROSESSIONID"  --------------------------------------------------------------------------- -- Kibro monad@@ -124,9 +126,10 @@ type Kibro = KibroT IO  -- | A state containing the current session and a database connection.-data KibroSt v = KibroSt { session    :: Session+data KibroSt v = KibroSt { session    :: Maybe Session                          , match      :: MatchResult -                         , kibroValue :: v }+                         , kibroValue :: v+                         , sessions   :: SessionState }  type MatchResult = ((String, (String, String)), [(Int, String)]) @@ -151,22 +154,14 @@   liftIO $ modifyMVar_ var $ \(ids,sessions) -> do     return (ids,M.insert id session sessions) --- | Get the current session or make a new one and return it-getSession :: Manager Session+-- | Get the current session+getSession :: Manager (Maybe Session) getSession = do   var <- ask-  sId <- lift $ readCookie "sid"-  sess <- liftIO $ modifyMVar var $ \state@(ids,sessions) -> do-    case sId >>= flip M.lookup sessions of-      Just session -> return (state,(False,session))-      Nothing      -> let sId' = head ids-                          session = Session sId' M.empty-                          newState = (tail ids,M.insert sId' session sessions)-                      in return (newState,(True,session))-  when (fst sess) $ lift $ setCookie (newCookie "sid" $ show (sessId $ snd sess)) { cookiePath = Just "/" }-  return $ snd sess-                         -+  sId <- lift $ readCookie sessionName+  (ids,sessions) <- liftIO $ readMVar var+  return $ sId >>= flip M.lookup sessions+                        -- | Generate an infinite list of session ids genIds :: IO [SessionId] genIds = nub . randomRs (1,1000^(20::Int)) <$> betterStdGen@@ -231,9 +226,8 @@ modifyRSess k f = do   v <- readSess k   case v of-    Just v  -> do writeSess k $ f v-                  return $ Just v     Nothing -> return Nothing+    Just v  -> do writeSess k $ f v; return $ Just v  -- | Read a session value readSess :: (Read a) => String -> Kibro v (Maybe a)@@ -264,8 +258,11 @@  -- | Get a session value getSess :: String -> Kibro v (Maybe String)-getSess k = do (Session _ s) <- gets session-               return $ M.lookup k s+getSess k = do+  sess <- gets session +  case sess of+    Just (Session _ s) -> return $ M.lookup k s+    Nothing            -> return Nothing  -- | Put a session value putSess :: String -> String -> Kibro v ()@@ -277,8 +274,21 @@  -- | Modify a session value sessMod :: (Map String String -> Map String String) -> Kibro v ()-sessMod mod = do (Session id s) <- gets session-                 modify $ \state -> state { session = Session id (mod s) }+sessMod mod = do+  sess <- gets session+  when (isNothing sess) makeSession+  Just (Session id s) <- gets session+  modify $ \state -> state { session = Just $ Session id (mod s) }++makeSession :: Kibro v ()+makeSession = do+  var <- gets sessions+  sess <- liftIO $ modifyMVar var $ \state@(id:ids,sessions) ->+                let session = Session id M.empty+                    newState = (ids,M.insert id session sessions)+                in return (newState,session)+  setCookie (newCookie sessionName $ show $ sessId sess) { cookiePath = Just "/" }+  modify $ \state -> state { session = Just sess }  ---------------------------------------- -- Some HTML utilities