1 module Rakka.SystemConfig
5 , mkSystemConfig -- private
12 import Control.Arrow.ArrowIO
13 import Control.Monad.Trans
14 import qualified Data.ByteString.Char8 as C8
17 import qualified Network.HTTP.Lucu.Config as LC
21 data SystemConfig = SystemConfig {
22 scLucuConf :: !LC.Config
32 mkSystemConfig :: LC.Config -> SystemConfig
33 mkSystemConfig = SystemConfig
36 getSysConf :: MonadIO m => SystemConfig -> SysConfValue -> m SysConfValue
38 = liftIO $ sysConfDefault sc key -- FIXME
41 getSysConfA :: ArrowIO a => SystemConfig -> SysConfValue -> a b SysConfValue
42 getSysConfA = (arrIO0 .) . getSysConf
46 sysConfPath :: SysConfValue -> FilePath
47 sysConfPath (SiteName _) = "/siteName"
48 sysConfPath (BaseURI _) = "/baseURI"
49 sysConfPath (StyleSheet _) = "/styleSheet"
53 marshalSysConf :: SysConfValue -> String
54 marshalSysConf (SiteName name) = name
55 marshalSysConf (BaseURI uri ) = uriToString id uri ""
56 marshalSysConf (StyleSheet name) = name
60 unmarshalSysConf :: SysConfValue -> String -> SysConfValue
61 unmarshalSysConf (SiteName _) name = SiteName name
62 unmarshalSysConf (BaseURI _) uri = BaseURI $ fromJust $ parseURI uri
63 unmarshalSysConf (StyleSheet _) name = StyleSheet name
66 {- getting default value -}
67 sysConfDefault :: SystemConfig -> SysConfValue -> IO SysConfValue
69 sysConfDefault _ (SiteName _)
70 = return $ SiteName "Rakka"
72 sysConfDefault sc (BaseURI _)
73 = do let conf = scLucuConf sc
74 host = C8.unpack $ LC.cnfServerHost conf
75 port = case LC.cnfServerPort conf of
76 PortNumber num -> fromIntegral num
79 = "http://" ++ host ++
82 else ':' : show port) ++ "/"
84 return $ BaseURI $ fromJust $ parseURI defaultURI
86 sysConfDefault _ (StyleSheet _)
87 = return $ StyleSheet "StyleSheet/Default"