diff --git a/src/Breve/Common.hs b/src/Breve/Common.hs deleted file mode 100644 index dde8958..0000000 --- a/src/Breve/Common.hs +++ /dev/null @@ -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 - } diff --git a/src/Breve/Settings.hs b/src/Breve/Settings.hs new file mode 100644 index 0000000..1873846 --- /dev/null +++ b/src/Breve/Settings.hs @@ -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 + }