Add ini-like config support

This commit is contained in:
rnhmjoj 2015-04-10 23:24:53 +02:00
parent bded0fb6bd
commit dd91af6b39

View File

@ -7,26 +7,57 @@ import Control.Applicative
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Text.Printf (printf) import Text.Printf (printf)
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import System.Environment.XDG.BaseDir
import System.Directory (doesFileExist)
import Data.TConfig
import Web.Simple.Templates import Web.Simple.Templates
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
data AppSettings = AppSettings { } data ServerSettings = ServerSettings
{ bindPort :: Int
, bindHostname :: String
, bindUrl :: String
, urlTable :: FilePath
, warpSettings :: Settings
} deriving Show
serverSettings :: IO (String, Settings) data AppSettings = AppSettings {}
serverSettings = do
port <- maybe 3000 read <$> lookupEnv "PORT"
host <- maybe "localhost" id <$> lookupEnv "HOSTNAME"
let opts = setPort port defaultSettings
url = if port == 80
then printf "http://%s/" host
else printf "http://%s:%d/" host port
return (url, opts)
newAppSettings :: IO AppSettings
newAppSettings = return AppSettings
instance HasTemplates IO AppSettings where instance HasTemplates IO AppSettings where
defaultLayout = do defaultLayout = do
main <- liftIO (getDataFileName "layouts/main.html") main <- liftIO (getDataFileName "layouts/main.html")
Just <$> getTemplate main Just <$> getTemplate main
newAppSettings :: IO 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 = do
urlsPath <- getUserDataFile "breve" ""
configPath <- getUserConfigFile "breve" ""
config <- readConfig =<< createEmptyIfMissing configPath
let host = maybe "localhost" id (getValue "hostname" config)
port = maybe 3000 read (getValue "port" config)
urls = maybe urlsPath id (getValue "urltable" config)
createEmptyIfMissing urls
return ServerSettings
{ bindPort = port
, bindHostname = host
, bindUrl = if port == 80
then printf "http://%s/" host
else printf "http://%s:%d/" host port
, urlTable = urls
, warpSettings = setPort port defaultSettings
}