rnhmjoj/breve
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use the configurator library

Browse Source
This commit is contained in:
rnhmjoj 2015-04-20 22:18:27 +02:00
parent e11e2de64c
commit 3764a15554
2 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
breve.cabal
View File

@ -34,5 +34,5 @@ executable breve
aeson, bytestring, binary, aeson, bytestring, binary,
transformers, mtl, transformers, mtl,
hashtables, cryptohash, random, hashtables, cryptohash, random,
xdg-basedir, tconfig, directory xdg-basedir, configurator, directory
ghc-options: -threaded -O2 ghc-options: -threaded -O2

35
src/Breve/Common.hs
View File

@ -1,21 +1,22 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
module Breve.Common where module Breve.Common where
import Paths_breve (getDataFileName) import Paths_breve (getDataFileName)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad (when)
import Text.Printf (printf) import Text.Printf (printf)
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import System.Environment.XDG.BaseDir import System.Environment.XDG.BaseDir
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Data.TConfig import Data.Configurator
import Web.Simple.Templates import Web.Simple.Templates
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
data ServerSettings = ServerSettings data ServerSettings = ServerSettings
{ bindPort :: Int { bindHostname :: String
, bindHostname :: String , bindPort :: Int
, bindUrl :: String , bindUrl :: String
, urlTable :: FilePath , urlTable :: FilePath
, warpSettings :: Settings , warpSettings :: Settings
@ -29,31 +30,31 @@ instance HasTemplates IO AppSettings where
Just <$> getTemplate main Just <$> getTemplate main
createEmptyIfMissing :: FilePath -> IO ()
createEmptyIfMissing file = do
exists <- doesFileExist file
when (not exists) (writeFile file "")
newAppSettings :: IO AppSettings newAppSettings :: IO AppSettings
newAppSettings = return AppSettings newAppSettings = return AppSettings
createEmptyIfMissing :: FilePath -> IO FilePath
createEmptyIfMissing file = do
exists <- doesFileExist file
if not exists
then writeFile file "" >> return file
else return file
newServerSettings :: IO ServerSettings newServerSettings :: IO ServerSettings
newServerSettings = do newServerSettings = do
urlsPath <- getUserDataFile "breve" "" urlsPath <- getUserDataFile "breve" ""
configPath <- getUserConfigFile "breve" "" configPath <- getUserConfigFile "breve" ""
config <- readConfig =<< createEmptyIfMissing configPath config <- load [Required configPath]
let host = maybe "localhost" id (getValue "hostname" config) host <- lookupDefault "localhost" config "hostname"
port = maybe 3000 read (getValue "port" config) port <- lookupDefault 3000 config "port"
urls = maybe urlsPath id (getValue "urltable" config) urls <- lookupDefault urlsPath config "urltable"
createEmptyIfMissing urls createEmptyIfMissing urls
return ServerSettings return ServerSettings
{ bindPort = port { bindHostname = host
, bindHostname = host , bindPort = port
, bindUrl = if port == 80 , bindUrl = if port == 80
then printf "http://%s/" host then printf "http://%s/" host
else printf "http://%s:%d/" host port else printf "http://%s:%d/" host port