Config.hs

module Text.Haggis.Config (
  parseConfig,
  rootUri,
  readTemplates,
  getBindPage,
  getBindTag,
  getBindComment,
  getBindSpecial,
  ) where

import Control.Applicative
import qualified Control.Exception as E

import qualified Data.Map.Lazy as M
import Data.Maybe
import Data.String.Utils

import Network.URI

import System.FilePath
import System.IO

import Text.Haggis.Parse
import Text.Haggis.Types
import qualified Text.Haggis.Binders as Bind
import Text.Parsec
import Text.XmlHtml

parseConfig :: FilePath -> SiteTemplates -> IO HaggisConfig
parseConfig fp ts = do
  inp <- E.catch (readFile fp)
               (\e -> do let err = show (e :: E.IOException)
                         hPutStr stderr ("Problem reading: " ++ err)
                         return "")
  let kvs = dieOnParseError fp $ parse keyValueParser "" inp
  return $ buildConfig (M.fromList kvs) ts

buildConfig :: M.Map String String
            -> SiteTemplates
            -> HaggisConfig
buildConfig kvs = let get = (flip M.lookup) kvs in HaggisConfig
  (fromMaybe "/" $ get "sitePath")
  (get "defaultAuthor")
  (get "siteHost")
  (get "rssTitle")
  (get "rssDescription")
  (get "sqlite3File")
  (get "indexTitle")
  -- binders
  Nothing
  Nothing
  Nothing
  Nothing

rootUri :: HaggisConfig -> Maybe URI
rootUri c = siteHost c >>= \h -> parseURI $ "http://" ++ pappend h (sitePath c)
  where
    pappend :: String -> String -> String
    pappend f s | (endswith "/" f && not (startswith "/" s)) ||
                (not (endswith "/" f) && startswith "/" s) = f ++ s
    pappend f s | not (endswith "/" f) && not (startswith "/" s) = f ++ "/" ++ s
    pappend f s = f ++ drop 1 s

readTemplates :: FilePath -> IO SiteTemplates
readTemplates fp = SiteTemplates <$> readTemplate (fp </> "root.html")
                                 <*> readTemplate (fp </> "single.html")
                                 <*> readTemplate (fp </> "multiple.html")
                                 <*> readTemplate (fp </> "tags.html")
                                 <*> readTemplate (fp </> "archives.html")

getBindPage :: HaggisConfig -> Page -> [Node] -> [Node]
getBindPage c = fromMaybe (Bind.bindPage c) (bindPage c)

getBindTag :: HaggisConfig -> String -> [Node] -> [Node]
getBindTag c = fromMaybe (Bind.bindTag c) (bindTag c)

getBindComment :: HaggisConfig -> Comment -> [Node] -> [Node]
getBindComment c = fromMaybe Bind.bindComment (bindComment c)

getBindSpecial :: HaggisConfig -> [MultiPage] -> [Node] -> [Node]
getBindSpecial c = fromMaybe (Bind.bindSpecial c) (bindSpecial c)