[Split up utilities module.
bjorn@bringert.net**20060423161226] {
adddir ./Hawl/Util
hunk ./Hawl/Session/Operations.hs 15
-import Hawl.Util
+import Hawl.Util.DB
+import Hawl.Util.Time
hunk ./Hawl/User/Operations.hs 11
-import Hawl.Util
+import Hawl.Util.DB
hunk ./Hawl/Util.hs 1
-{-# OPTIONS_GHC -fglasgow-exts #-}
-
-module Hawl.Util where
-
-import Database.HaskellDB
-import Database.HaskellDB.PrimQuery (TableName)
-import Database.HaskellDB.Query (Table(..))
-
-import System.Time
-
---
--- * Time utilities
---
-
-type Minutes = Int
-
-timeNow :: IO CalendarTime
-timeNow = getClockTime >>= toCalendarTime
-
-addToCalendarTime :: TimeDiff -> CalendarTime -> CalendarTime
-addToCalendarTime d t = toUTCTime $ addToClockTime d $ toClockTime t
-
-minutesBefore :: Minutes -> CalendarTime -> CalendarTime
-minutesBefore m t = addToCalendarTime (noTimeDiff { tdMin = m} ) t
-
-epoch :: CalendarTime
-epoch = CalendarTime {
- ctYear = 1970,
- ctMonth = January,
- ctDay = 1,
- ctHour = 0,
- ctMin = 0,
- ctSec = 0,
- ctPicosec = 0,
- ctWDay = Thursday,
- ctYDay = 1,
- ctTZName = "UTC",
- ctTZ = 0,
- ctIsDST = False
- }
-
---
--- * HaskellDB utilities
---
-
-query1 db q =
- do
- rs <- query db q
- case rs of
- [] -> fail "Query returned no results."
- [r] -> return r
- _ -> fail "Query returned more than one result."
-
-query01 db q =
- do
- rs <- query db q
- case rs of
- [] -> return Nothing
- [r] -> return $ Just r
- _ -> fail "Query returned more than one result."
-
-
-updateField db tab field start upd = transaction db t
- where
- get = do
- rs <- query db $ do
- t <- table tab
- project (field << t!field)
- case rs of
- [] -> return Nothing
- [n] -> return $ Just (n!field)
- _ -> fail $ "updateField: Multiple records in " ++ tableName tab
- t = do
- mr <- get
- case mr of
- Nothing -> do
- insert db tab start
- mr <- get
- case mr of
- Nothing -> fail $ "updateField: Insert didn't work"
- Just x -> return x
- Just x -> do
- let x' = upd x
- update db tab (\r -> constant True) (\r -> field <<- x')
- return x'
-
-tableName :: Table t -> TableName
-tableName (Table n _) = n
rmfile ./Hawl/Util.hs
addfile ./Hawl/Util/CGI.hs
hunk ./Hawl/Util/CGI.hs 1
+module Hawl.Util.CGI where
+
+import Control.Exception (Exception)
+
+import Network.NewCGI
+
+cgiErrorHandler :: Exception -> CGI CGIResult
+cgiErrorHandler e =
+ do
+ setHeader "Status" "500"
+ logCGI (show e)
+ output $ unlines ["",
+ "500 Internal Server Error",
+ "",
+ "Internal Server Error
",
+ "" ++ show e ++ "
",
+ ""]
addfile ./Hawl/Util/DB.hs
hunk ./Hawl/Util/DB.hs 1
+module Hawl.Util.DB where
+
+import Database.HaskellDB
+import Database.HaskellDB.PrimQuery (TableName)
+import Database.HaskellDB.Query (Table(..))
+
+
+query1 db q =
+ do
+ rs <- query db q
+ case rs of
+ [] -> fail "Query returned no results."
+ [r] -> return r
+ _ -> fail "Query returned more than one result."
+
+query01 db q =
+ do
+ rs <- query db q
+ case rs of
+ [] -> return Nothing
+ [r] -> return $ Just r
+ _ -> fail "Query returned more than one result."
+
+
+updateField db tab field start upd = transaction db t
+ where
+ get = do
+ rs <- query db $ do
+ t <- table tab
+ project (field << t!field)
+ case rs of
+ [] -> return Nothing
+ [n] -> return $ Just (n!field)
+ _ -> fail $ "updateField: Multiple records in " ++ tableName tab
+ t = do
+ mr <- get
+ case mr of
+ Nothing -> do
+ insert db tab start
+ mr <- get
+ case mr of
+ Nothing -> fail $ "updateField: Insert didn't work"
+ Just x -> return x
+ Just x -> do
+ let x' = upd x
+ update db tab (\r -> constant True) (\r -> field <<- x')
+ return x'
+
+tableName :: Table t -> TableName
+tableName (Table n _) = n
addfile ./Hawl/Util/Time.hs
hunk ./Hawl/Util/Time.hs 1
-
+module Hawl.Util.Time where
+
+import System.Time
+
+--
+-- * Time utilities
+--
+
+type Minutes = Int
+
+timeNow :: IO CalendarTime
+timeNow = getClockTime >>= toCalendarTime
+
+addToCalendarTime :: TimeDiff -> CalendarTime -> CalendarTime
+addToCalendarTime d t = toUTCTime $ addToClockTime d $ toClockTime t
+
+minutesBefore :: Minutes -> CalendarTime -> CalendarTime
+minutesBefore m t = addToCalendarTime (noTimeDiff { tdMin = m} ) t
+
+epoch :: CalendarTime
+epoch = CalendarTime {
+ ctYear = 1970,
+ ctMonth = January,
+ ctDay = 1,
+ ctHour = 0,
+ ctMin = 0,
+ ctSec = 0,
+ ctPicosec = 0,
+ ctWDay = Thursday,
+ ctYDay = 1,
+ ctTZName = "UTC",
+ ctTZ = 0,
+ ctIsDST = False
+ }
hunk ./hawl.cabal 9
-build-depends: haskell98, base, haskelldb
+build-depends: haskell98, base, haskelldb, cgi, xhtml
hunk ./hawl.cabal 26
- Hawl.Util
+ Hawl.Util.CGI,
+ Hawl.Util.DB,
+ Hawl.Util.Time
}