packages feed

haggis 0.1.1.1 → 0.1.1.2

raw patch · 6 files changed

+63/−27 lines, 6 files

Files

haggis.cabal view
@@ -1,5 +1,5 @@ name:                haggis-version:             0.1.1.1+version:             0.1.1.2 synopsis:            A static site generator with blogging/comments support homepage:            http://github.com/tych0/haggis license:             MIT
src/Text/Haggis.hs view
@@ -18,7 +18,6 @@  import Text.XmlHtml -import Text.Haggis.Binders import Text.Haggis.Comments import Text.Haggis.Config import Text.Haggis.Parse@@ -47,7 +46,7 @@   sequence_ $ map writePage ps   sequence_ $ map writeMultiPage mps   where-    wrapper = bindSpecial config mps $ root (siteTemplates config)+    wrapper = getBindSpecial config mps $ root (siteTemplates config)     writeThing fp title ns = do       let xform = hq "#content *" (Group ns) . hq "title *" title           html = xform $ wrapper@@ -56,21 +55,21 @@       BS.writeFile path $ renderHtml html     writePage :: Page -> IO ()     writePage p =-      let content = bindPage config p $ single (siteTemplates config)+      let content = getBindPage config p $ single (siteTemplates config)       in writeThing (pagePath p) (pageTitle p) content     writeMultiPage :: MultiPage -> IO ()     writeMultiPage mp =-      let xform = hq ".page *" $ map (bindPage config) $ singlePages mp+      let xform = hq ".page *" $ map (getBindPage config) $ singlePages mp           content = xform $ multiple (siteTemplates config)           path = mpTypeToPath $ multiPageType mp-      in writeThing path (mpTypeToTitle $ multiPageType mp) content+      in writeThing path (mpTypeToTitle config $ multiPageType mp) content  ensureDirExists :: FilePath -> IO () ensureDirExists = createDirectoryIfMissing True . dropFileName  generateSpecial :: HaggisConfig -> [MultiPage] -> [Page] generateSpecial config mps =-  let bind = bindSpecial config mps+  let bind = getBindSpecial config mps       archivesContent = bind (archivesTemplate $ siteTemplates config)       archives = plainPage "Archives" "./archives/index.html" archivesContent       tagsContent = bind (tagsTemplate $ siteTemplates config)
src/Text/Haggis/Binders.hs view
@@ -15,7 +15,7 @@  import Text.Pandoc.Readers.Markdown import Text.Pandoc.Options-import Text.Haggis.Types+import Text.Haggis.Types hiding (bindPage, bindComment, bindTag, bindSpecial) import Text.Haggis.Utils import Text.Hquery import Text.XmlHtml@@ -31,7 +31,7 @@                      } =   let bindTags = if null tags                    then hq ".tags" nothing-                   else hq ".tag *" (map (bindTag config) tags)+                   else hq ".tag *" $ addCommas (map (bindTag config) tags)       auth = maybe (defaultAuthor config) Just author   in hq ".title *" title .      bindTags .@@ -52,8 +52,14 @@     nameBind Nothing = hq ".name" (commenterName c) bindTag :: HaggisConfig -> String -> [Node] -> [Node] bindTag config t = hq "a [href]" (sitePath config </> (mpTypeToPath $ Tag t)) .-                   hq "a *" (t ++ ", ")+                   hq "a *" (t) +addCommas :: [[Node] -> [Node]] -> [[Node] -> [Node]]+addCommas ns | not (null ns) = let l = last ns+                                   is = init ns+                               in map (hq "* +" ", " .) is ++ [l]+addCommas ns = ns+ bindSpecial :: HaggisConfig -> [MultiPage] -> [Node] -> [Node] bindSpecial config mps = let (archives, tags) = bindAggregates                          in hq ".tag" tags . hq ".archive *" archives@@ -64,7 +70,8 @@                            hq "a *" (show y ++ " - " ++ show m)                          bind (MultiPage xs typ@(Tag t)) = Right $                            hq ".tag [href]" (sitePath config </> mpTypeToPath typ) .-                           hq ".tag *" (t ++ " (" ++ show (length xs) ++ "), ")+                           hq ".tag *" (t ++ " (" ++ show (length xs) ++ ")")                          bind _ = Left $ hq "*" nothing-                     in partitionEithers $ map bind mps+                         (archives, tags) = partitionEithers $ map bind mps+                     in (archives, addCommas tags)
src/Text/Haggis/Comments.hs view
@@ -16,8 +16,6 @@ import qualified Data.Traversable as T import Data.Typeable -import Prelude hiding (catch)- import System.FilePath  import Text.Haggis.Types
src/Text/Haggis/Config.hs view
@@ -1,11 +1,15 @@ module Text.Haggis.Config (   parseConfig,   rootUri,-  readTemplates+  readTemplates,+  getBindPage,+  getBindTag,+  getBindComment,+  getBindSpecial,   ) where  import Control.Applicative-import Control.Exception+import qualified Control.Exception as E  import qualified Data.Map.Lazy as M import Data.Maybe@@ -13,25 +17,27 @@  import Network.URI -import Prelude hiding (catch)- 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 <- catch (readFile fp)-               (\e -> do let err = show (e :: IOException)+  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 :: M.Map String String+            -> SiteTemplates+            -> HaggisConfig buildConfig kvs = let get = (flip M.lookup) kvs in HaggisConfig   (fromMaybe "/" $ get "sitePath")   (get "defaultAuthor")@@ -39,6 +45,12 @@   (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)@@ -56,3 +68,14 @@                                  <*> 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)
src/Text/Haggis/Types.hs view
@@ -60,10 +60,10 @@   let month = fromMaybe "index" $ fmap show m   in "archives" </> show y </> month <.> "html" -mpTypeToTitle :: MultiPageType -> String-mpTypeToTitle (Tag t) = "Tagged: " ++ t-mpTypeToTitle (DirIndex d) = "Filed under: " ++ d-mpTypeToTitle (Archive y m) =+mpTypeToTitle :: HaggisConfig -> MultiPageType -> String+mpTypeToTitle _ (Tag t) = "Tagged: " ++ t+mpTypeToTitle conf (DirIndex d) = fromMaybe ("Filed under: " ++ d) (indexTitle conf)+mpTypeToTitle _ (Archive y m) =   let month = fromMaybe "" $ fmap ((" - " ++) . show) m   in "Posts from: " ++ (show y) ++ month @@ -82,7 +82,7 @@   defaultAuthor :: Maybe String,    -- | Hostname where the blog is hosted, used for generating RSS feed links.-  -- E.g. blog.example.com+  -- E.g. blog.example.com, blog.example.com:8080   siteHost :: Maybe String,   rssTitle :: Maybe String,   rssDescription :: Maybe String,@@ -90,8 +90,17 @@   -- | Sqlite3 file name, for comments.   sqlite3File :: Maybe FilePath, +  -- | Index page title.+  indexTitle :: Maybe String,++  -- * Custom binders for pages. See "Text.Haggis.Binders" for the defaults.+  bindPage :: Maybe (Page -> [Node] -> [Node]),+  bindTag :: Maybe (String -> [Node] -> [Node]),+  bindComment :: Maybe (Comment -> [Node] -> [Node]),+  bindSpecial :: Maybe ([MultiPage] -> [Node] -> [Node]),+   siteTemplates :: SiteTemplates-} deriving (Show)+}  data Comment = Comment {   commenterName :: String,