Rename settings module
This commit is contained in:
parent
d26f21aebb
commit
0e73049009
@ -1,63 +0,0 @@
|
|||||||
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
|
|
||||||
module Breve.Common where
|
|
||||||
|
|
||||||
import Paths_breve (getDataFileName)
|
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Text.Printf (printf)
|
|
||||||
import System.Environment (lookupEnv)
|
|
||||||
import System.Environment.XDG.BaseDir
|
|
||||||
import System.Directory (doesFileExist)
|
|
||||||
import Data.Configurator
|
|
||||||
|
|
||||||
import Web.Simple.Templates
|
|
||||||
import Network.Wai.Handler.Warp
|
|
||||||
|
|
||||||
data ServerSettings = ServerSettings
|
|
||||||
{ bindHostname :: String
|
|
||||||
, bindPort :: Int
|
|
||||||
, bindUrl :: String
|
|
||||||
, urlTable :: FilePath
|
|
||||||
, warpSettings :: Settings
|
|
||||||
}
|
|
||||||
|
|
||||||
data AppSettings = AppSettings {}
|
|
||||||
|
|
||||||
instance HasTemplates IO AppSettings where
|
|
||||||
defaultLayout = do
|
|
||||||
main <- liftIO (getDataFileName "static/main.html")
|
|
||||||
Just <$> getTemplate main
|
|
||||||
|
|
||||||
|
|
||||||
createEmptyIfMissing :: FilePath -> IO ()
|
|
||||||
createEmptyIfMissing file = do
|
|
||||||
exists <- doesFileExist file
|
|
||||||
when (not exists) (writeFile file "")
|
|
||||||
|
|
||||||
|
|
||||||
newAppSettings :: IO AppSettings
|
|
||||||
newAppSettings = return AppSettings
|
|
||||||
|
|
||||||
|
|
||||||
newServerSettings :: IO ServerSettings
|
|
||||||
newServerSettings = do
|
|
||||||
urlsPath <- getUserDataFile "breve" ""
|
|
||||||
configPath <- getUserConfigFile "breve" ""
|
|
||||||
|
|
||||||
config <- load [Required configPath]
|
|
||||||
host <- lookupDefault "localhost" config "hostname"
|
|
||||||
port <- lookupDefault 3000 config "port"
|
|
||||||
urls <- lookupDefault urlsPath config "urltable"
|
|
||||||
|
|
||||||
createEmptyIfMissing urls
|
|
||||||
|
|
||||||
return ServerSettings
|
|
||||||
{ bindHostname = host
|
|
||||||
, bindPort = port
|
|
||||||
, bindUrl = if port == 80
|
|
||||||
then printf "http://%s/" host
|
|
||||||
else printf "http://%s:%d/" host port
|
|
||||||
, urlTable = urls
|
|
||||||
, warpSettings = setPort port defaultSettings
|
|
||||||
}
|
|
45
src/Breve/Settings.hs
Normal file
45
src/Breve/Settings.hs
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module Breve.Settings where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
|
import System.Environment.XDG.BaseDir
|
||||||
|
import System.Directory (doesFileExist)
|
||||||
|
import Data.Configurator
|
||||||
|
import Data.Monoid
|
||||||
|
|
||||||
|
data AppSettings = AppSettings
|
||||||
|
{ bindPort :: Int
|
||||||
|
, bindUrl :: String
|
||||||
|
, urlTable :: FilePath
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
createEmptyIfMissing :: FilePath -> IO ()
|
||||||
|
createEmptyIfMissing file = do
|
||||||
|
exists <- doesFileExist file
|
||||||
|
when (not exists) (writeFile file "")
|
||||||
|
|
||||||
|
|
||||||
|
settings :: IO AppSettings
|
||||||
|
settings = do
|
||||||
|
urlsPath <- getUserDataFile "breve" ""
|
||||||
|
configPath <- getUserConfigFile "breve" ""
|
||||||
|
|
||||||
|
config <- load [Required configPath]
|
||||||
|
host <- lookupDefault "localhost" config "hostname"
|
||||||
|
port <- lookupDefault 3000 config "port"
|
||||||
|
urls <- lookupDefault urlsPath config "urltable"
|
||||||
|
|
||||||
|
createEmptyIfMissing urls
|
||||||
|
|
||||||
|
let base = "http://" <> host
|
||||||
|
url = if port == 80
|
||||||
|
then base
|
||||||
|
else base <> ":" <> show port
|
||||||
|
|
||||||
|
return AppSettings
|
||||||
|
{ bindPort = port
|
||||||
|
, bindUrl = url <> "/"
|
||||||
|
, urlTable = urls
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user