{-# LANGUAGE MultiParamTypeClasses #-} module Breve.Common where import Paths_breve (getDataFileName) import Control.Monad.IO.Class (liftIO) import Text.Printf (printf) import System.Environment (lookupEnv) import System.Environment.XDG.BaseDir import System.Directory (doesFileExist) import Data.TConfig import Web.Simple.Templates import Network.Wai.Handler.Warp data ServerSettings = ServerSettings { bindPort :: Int , bindHostname :: String , bindUrl :: String , urlTable :: FilePath , warpSettings :: Settings } data AppSettings = AppSettings {} instance HasTemplates IO AppSettings where defaultLayout = do main <- liftIO (getDataFileName "layouts/main.html") 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 }