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