Add ini-like config support
This commit is contained in:
parent
bded0fb6bd
commit
dd91af6b39
@ -7,26 +7,57 @@ import Control.Applicative
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Text.Printf (printf)
|
||||
import System.Environment (lookupEnv)
|
||||
import System.Environment.XDG.BaseDir
|
||||
import System.Directory (doesFileExist)
|
||||
import Data.TConfig
|
||||
|
||||
import Web.Simple.Templates
|
||||
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)
|
||||
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
|
||||
data AppSettings = AppSettings {}
|
||||
|
||||
instance HasTemplates IO AppSettings where
|
||||
defaultLayout = do
|
||||
main <- liftIO (getDataFileName "layouts/main.html")
|
||||
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
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user