add configuration
This commit is contained in:
parent
80b3cfa07e
commit
52968be8b1
5 changed files with 91 additions and 12 deletions
6
conig.yaml
Normal file
6
conig.yaml
Normal file
|
@ -0,0 +1,6 @@
|
|||
api_host: "localhost"
|
||||
api_port: 8000
|
||||
#api_uri: ""
|
||||
#api_secure: false
|
||||
listen_port: 3000
|
||||
locales_location: "./locales"
|
|
@ -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
|
||||
|
|
34
src/Main.hs
34
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
|
||||
(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 "./locales"
|
||||
(l10n, _) <- getL10n (T.unpack locs)
|
||||
withStdoutLogger $ \ilog -> do
|
||||
let settings = setPort 3000 $ setLogger ilog defaultSettings
|
||||
let settings = setPort (fromIntegral listenPort) $
|
||||
setLogger ilog defaultSettings
|
||||
initState = ReadState
|
||||
-- { rsManager = manager
|
||||
{ rsL10n = l10n
|
||||
, rsBackend = mkClientEnv mngr (BaseUrl Http "localhost" 8000 "")
|
||||
, 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 $
|
||||
|
|
|
@ -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
|
||||
|
|
43
src/Types/Configuration.hs
Normal file
43
src/Types/Configuration.hs
Normal file
|
@ -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"
|
||||
)
|
Loading…
Reference in a new issue