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 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
|
||||||
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user