Common.hs

{-# LANGUAGE MultiParamTypeClasses #-}
module Breve.Common where

import Paths_breve                     (getDataFileName)

import Control.Applicative
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
    }