diff --git a/breve.cabal b/breve.cabal index fe1ebe6..36dc252 100644 --- a/breve.cabal +++ b/breve.cabal @@ -34,5 +34,5 @@ executable breve aeson, bytestring, binary, transformers, mtl, hashtables, cryptohash, random, - xdg-basedir, tconfig, directory + xdg-basedir, configurator, directory ghc-options: -threaded -O2 diff --git a/src/Breve/Common.hs b/src/Breve/Common.hs index 4dbfed9..01f8a6a 100644 --- a/src/Breve/Common.hs +++ b/src/Breve/Common.hs @@ -1,21 +1,22 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# 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.TConfig +import Data.Configurator import Web.Simple.Templates import Network.Wai.Handler.Warp data ServerSettings = ServerSettings - { bindPort :: Int - , bindHostname :: String + { bindHostname :: String + , bindPort :: Int , bindUrl :: String , urlTable :: FilePath , warpSettings :: Settings @@ -29,31 +30,31 @@ instance HasTemplates IO AppSettings where Just <$> getTemplate main +createEmptyIfMissing :: FilePath -> IO () +createEmptyIfMissing file = do + exists <- doesFileExist file + when (not exists) (writeFile file "") + + 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) + + config <- load [Required configPath] + host <- lookupDefault "localhost" config "hostname" + port <- lookupDefault 3000 config "port" + urls <- lookupDefault urlsPath config "urltable" createEmptyIfMissing urls return ServerSettings - { bindPort = port - , bindHostname = host + { bindHostname = host + , bindPort = port , bindUrl = if port == 80 then printf "http://%s/" host else printf "http://%s:%d/" host port