Rakka/SystemConfig.hs

   1 module Rakka.SystemConfig
   2     ( SystemConfig
   3     , SysConfValue(..)
   4
   5     , mkSystemConfig -- private
   6
   7     , getSysConf
   8     , getSysConfA
   9     )
  10     where
  11
  12 import           Control.Arrow.ArrowIO
  13 import           Control.Monad.Trans
  14 import qualified Data.ByteString.Char8 as C8
  15 import           Data.Maybe
  16 import           Network
  17 import qualified Network.HTTP.Lucu.Config as LC
  18 import           Network.URI
  19
  20
  21 data SystemConfig = SystemConfig {
  22       scLucuConf :: !LC.Config
  23     }
  24
  25
  26 data SysConfValue
  27     = SiteName String
  28     | BaseURI URI
  29     | DefaultPage String
  30     | StyleSheet String
  31
  32
  33 mkSystemConfig :: LC.Config -> SystemConfig
  34 mkSystemConfig = SystemConfig
  35
  36
  37 getSysConf :: MonadIO m => SystemConfig -> SysConfValue -> m SysConfValue
  38 getSysConf sc key
  39     = liftIO $ sysConfDefault sc key -- FIXME
  40
  41
  42 getSysConfA :: ArrowIO a => SystemConfig -> SysConfValue -> a b SysConfValue
  43 getSysConfA = (arrIO0 .) . getSysConf
  44
  45
  46 {- paths -}
  47 sysConfPath :: SysConfValue -> FilePath
  48 sysConfPath (SiteName    _) = "/siteName"
  49 sysConfPath (BaseURI     _) = "/baseURI"
  50 sysConfPath (DefaultPage _) = "/defaultPage"
  51 sysConfPath (StyleSheet  _) = "/styleSheet"
  52
  53
  54 {- marshalling -}
  55 marshalSysConf :: SysConfValue -> String
  56 marshalSysConf (SiteName    name) = name
  57 marshalSysConf (BaseURI     uri ) = uriToString id uri ""
  58 marshalSysConf (DefaultPage name) = name
  59 marshalSysConf (StyleSheet  name) = name
  60
  61
  62 {- unmarshalling -}
  63 unmarshalSysConf :: SysConfValue -> String -> SysConfValue
  64 unmarshalSysConf (SiteName    _) name = SiteName name
  65 unmarshalSysConf (BaseURI     _) uri  = BaseURI $ fromJust $ parseURI uri
  66 unmarshalSysConf (DefaultPage _) name = DefaultPage name
  67 unmarshalSysConf (StyleSheet  _) name = StyleSheet name
  68
  69
  70 {- getting default value -}
  71 sysConfDefault :: SystemConfig -> SysConfValue -> IO SysConfValue
  72
  73 sysConfDefault _ (SiteName _)
  74     = return $ SiteName "Rakka"
  75
  76 sysConfDefault sc (BaseURI _)
  77     = do let conf = scLucuConf sc
  78              host = C8.unpack $ LC.cnfServerHost conf
  79              port = case LC.cnfServerPort conf of
  80                       PortNumber num -> fromIntegral num
  81
  82              defaultURI
  83                   = "http://" ++ host ++
  84                     (if port == 80
  85                      then ""
  86                      else ':' : show port) ++ "/"
  87
  88          return $ BaseURI $ fromJust $ parseURI defaultURI
  89
  90 sysConfDefault _ (DefaultPage _)
  91     = return $ DefaultPage "MainPage"
  92
  93 sysConfDefault _ (StyleSheet _)
  94     = return $ StyleSheet "StyleSheet/Default"