wrote much code...

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
new file mode 100644 (file)
index 0000000..ea7e370
--- /dev/null
+++ b/Rakka/SystemConfig.hs
@@ -0,0 +1,87 @@
+module Rakka.SystemConfig
+    ( SystemConfig
+    , SysConfValue(..)
+
+    , mkSystemConfig -- private
+
+    , getSysConf
+    , getSysConfA
+    )
+    where
+
+import           Control.Arrow.ArrowIO
+import           Control.Monad.Trans
+import qualified Data.ByteString.Char8 as C8
+import           Data.Maybe
+import           Network
+import qualified Network.HTTP.Lucu.Config as LC
+import           Network.URI
+
+
+data SystemConfig = SystemConfig {
+      scLucuConf :: !LC.Config
+    }
+
+
+data SysConfValue
+    = SiteName String
+    | BaseURI URI
+    | StyleSheet String
+
+
+mkSystemConfig :: LC.Config -> SystemConfig
+mkSystemConfig = SystemConfig
+
+
+getSysConf :: MonadIO m => SystemConfig -> SysConfValue -> m SysConfValue
+getSysConf sc key
+    = liftIO $ sysConfDefault sc key -- FIXME
+
+
+getSysConfA :: ArrowIO a => SystemConfig -> SysConfValue -> a b SysConfValue
+getSysConfA = (arrIO0 .) . getSysConf
+
+
+{- paths -}
+sysConfPath :: SysConfValue -> FilePath
+sysConfPath (SiteName   _) = "/siteName"
+sysConfPath (BaseURI    _) = "/baseURI"
+sysConfPath (StyleSheet _) = "/styleSheet"
+
+
+{- marshalling -}
+marshalSysConf :: SysConfValue -> String
+marshalSysConf (SiteName   name) = name
+marshalSysConf (BaseURI    uri ) = uriToString id uri ""
+marshalSysConf (StyleSheet name) = name
+
+
+{- unmarshalling -}
+unmarshalSysConf :: SysConfValue -> String -> SysConfValue
+unmarshalSysConf (SiteName   _) name = SiteName name
+unmarshalSysConf (BaseURI    _) uri  = BaseURI $ fromJust $ parseURI uri
+unmarshalSysConf (StyleSheet _) name = StyleSheet name
+
+
+{- getting default value -}
+sysConfDefault :: SystemConfig -> SysConfValue -> IO SysConfValue
+
+sysConfDefault _ (SiteName _)
+    = return $ SiteName "Rakka"
+
+sysConfDefault sc (BaseURI _)
+    = do let conf = scLucuConf sc
+             host = C8.unpack $ LC.cnfServerHost conf
+             port = case LC.cnfServerPort conf of
+                      PortNumber num -> fromIntegral num
+             
+             defaultURI
+                  = "http://" ++ host ++
+                    (if port == 80
+                     then ""
+                     else ':' : show port) ++ "/"
+
+         return $ BaseURI $ fromJust $ parseURI defaultURI
+
+sysConfDefault _ (StyleSheet _)
+    = return $ StyleSheet "StyleSheet/Default"