Rakka/Environment.hs

   1 module Rakka.Environment
   2     ( Environment(..)
   3     , setupEnv
   4
   5     , getSiteName
   6     , getSiteNameA
   7
   8     , getBaseURI
   9     , getBaseURIA
  10     )
  11     where
  12
  13 import           Control.Arrow.ArrowIO
  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 import           Rakka.Storage
  20
  21
  22 data Environment = Environment {
  23       envLocalStateDir :: FilePath
  24     , envLucuConf      :: LC.Config
  25     , envStorage       :: Storage
  26     }
  27
  28
  29 setupEnv :: FilePath -> PortNumber -> IO Environment
  30 setupEnv lsdir portNum
  31     = do let lucuConf = LC.defaultConfig {
  32                           LC.cnfServerPort = PortNumber portNum
  33                         }
  34          storage <- mkStorage -- FIXME
  35          return $ Environment {
  36                       envLocalStateDir = lsdir
  37                     , envLucuConf      = lucuConf
  38                     , envStorage       = storage
  39                     }
  40
  41
  42 getSiteName :: Environment -> IO String
  43 getSiteName env
  44     = return "Rakka" -- FIXME
  45
  46
  47 getSiteNameA :: ArrowIO a => Environment -> a b String
  48 getSiteNameA = arrIO0 . getSiteName
  49
  50
  51 getBaseURI :: Environment -> IO URI
  52 getBaseURI env
  53     = do let conf = envLucuConf env
  54              host = C8.unpack $ LC.cnfServerHost conf
  55              port = case LC.cnfServerPort conf of
  56                       PortNumber num -> fromIntegral num
  57
  58              defaultURI
  59                   = "http://" ++ host ++
  60                     (if port == 80
  61                      then ""
  62                      else ':' : show port) ++ "/"
  63
  64          return $ fromJust $ parseURI defaultURI -- FIXME
  65
  66
  67 getBaseURIA :: ArrowIO a => Environment -> a b URI
  68 getBaseURIA = arrIO0 . getBaseURI