add configuration

conig.yaml

@@ -0,0 +1,6 @@
+api_host: "localhost"
+api_port: 8000
+#api_uri: ""
+#api_secure: false
+listen_port: 3000
+locales_location: "./locales"

matebeamter.cabal

@@ -29,6 +29,7 @@ executable matebeamter
                      , Types.Reader
                      , Types.Views
                      , Types.Orphans
+                     , Types.Configuration
                      , Control
                      , Control.Auth
                      , Control.User
@@ -71,6 +72,8 @@ executable matebeamter
                      , stm
                      , stm-containers
                      , either
+                     , optparse-applicative
+                     , HsYAML
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall

src/Main.hs

@@ -12,7 +12,13 @@ import Network.HTTP.Client hiding (Proxy)
 
 import Control.Monad.Reader
 
+import Data.String (fromString)
 import Data.Text.I18n.Po
+import qualified Data.Text as T
+import Data.ByteString.Lazy as BL hiding (putStrLn)
+import Data.YAML
+
+import Options.Applicative
 
 -- internal imports
 
@@ -22,18 +28,38 @@ import Control
 
 main :: IO ()
 main = do
-  mngr <- newManager defaultManagerSettings
-  (l10n, _) <- getL10n "./locales"
-  withStdoutLogger $ \ilog -> do
-    let settings = setPort 3000 $ setLogger ilog defaultSettings
-        initState = ReadState
-          -- { rsManager = manager
-          { rsL10n       = l10n
-          , rsBackend    = mkClientEnv mngr (BaseUrl Http "localhost" 8000 "")
-          , rsHashParams = recommendedHashParams
-          }
-          
-    runSettings settings (userApp initState)
+  (Options confLoc) <- execParser opts
+  raw <- BL.readFile (T.unpack confLoc)
+  case decode1 raw of
+    Left (loc, msg) ->
+      error (T.unpack $ confLoc <> ":" <>
+        fromString (prettyPosWithSource loc raw " error") <>
+        fromString msg)
+    Right (Configuration apiHost apiPort apiUri apiSec listenPort locs) -> do
+      mngr <- newManager defaultManagerSettings
+      (l10n, _) <- getL10n (T.unpack locs)
+      withStdoutLogger $ \ilog -> do
+        let settings = setPort (fromIntegral listenPort) $
+              setLogger ilog defaultSettings
+            initState = ReadState
+              -- { rsManager = manager
+              { rsL10n       = l10n
+              , rsBackend    = mkClientEnv mngr
+                (BaseUrl
+                  (if apiSec then Https else Http)
+                  (T.unpack apiHost)
+                  (fromIntegral apiPort)
+                  (T.unpack apiUri)
+                  )
+              , rsHashParams = recommendedHashParams
+              }
+        putStrLn "Starting up..."
+        runSettings settings (userApp initState)
+  where
+    opts = info (options <**> helper)
+      ( fullDesc
+     <> progDesc "Run the \"matebeamter\" frontend to the \"mateamt\" API."
+     <> header "matebeamter - a client for mateamt" )
 
 userApp :: ReadState -> Application
 userApp initState = serveWithContext userApi EmptyContext $

src/Types.hs

@@ -7,3 +7,4 @@ import Types.Page as T
 import Types.Reader as T
 import Types.Views as T
 import Types.Orphans as T
+import Types.Configuration as T

src/Types/Configuration.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Types.Configuration where
+
+import qualified Data.Text as T
+
+import Options.Applicative as O
+
+import Data.YAML as Y
+
+import GHC.Generics
+
+data Configuration = Configuration
+  { configApiHost :: T.Text
+  , configApiPort :: Word
+  , configApiUri :: T.Text
+  , configApiSecure :: Bool
+  , configListenPort :: Word
+  , configLocalesLocation :: T.Text
+  }
+  deriving (Generic, Show)
+
+instance FromYAML Configuration where
+  parseYAML = withMap "Configuration" $ \m -> Configuration
+    <$> m .: "api_host"
+    <*> m .: "api_port"
+    <*> m .:? "api_uri" .!= ""
+    <*> m .:? "api_secure" .!= False
+    <*> m .: "listen_port"
+    <*> m .: "locales_location"
+
+data Options = Options
+  { optConfigLocation :: T.Text
+  }
+
+options :: O.Parser Options
+options = Options
+  <$> strOption
+    ( long "configuration"
+    <> short 'c'
+    <> metavar "FILEPATH"
+    <> help "The location of the configuration YAML-file"
+    )