diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,3 +6,6 @@ ## hakyll-dir-list 0.1.1.0 - bump hakyll to 4.11.0.0 + +## hakyll-dir-list 1.0.0.0 +- configurable begin and end tags for items and collections diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,6 +14,7 @@ * `$begin-tags$` injects `
  • ` and `` tags * `$full-page-id$` is the hyphen seperated path of the page +* use configuration to get level dependant structuring tags ### Metainformation in the source files For each subdirectory which should be processed one source file with the same base name should exist which can contain meta information: diff --git a/hakyll-dir-list.cabal b/hakyll-dir-list.cabal --- a/hakyll-dir-list.cabal +++ b/hakyll-dir-list.cabal @@ -1,5 +1,5 @@ name: hakyll-dir-list -version: 0.1.1.0 +version: 1.0.0.0 synopsis: Allow Hakyll to create hierarchical menues from directories. @@ -30,6 +30,7 @@ , hakyll == 4.11.* , filepath , containers + , data-default hs-source-dirs: src Ghc-options: -Wall default-language: Haskell2010 diff --git a/src/Hakyll/Web/Template/DirList.hs b/src/Hakyll/Web/Template/DirList.hs --- a/src/Hakyll/Web/Template/DirList.hs +++ b/src/Hakyll/Web/Template/DirList.hs @@ -2,21 +2,86 @@ {-# LANGUAGE TupleSections #-} module Hakyll.Web.Template.DirList ( - dirListField + Configuration (..) + , defaultConfiguration + , metadataConfiguration + , dirListField ) where --import Data.Monoid (mappend) import Control.Monad (liftM) import Data.List (sortBy) import Data.Ord (comparing) -import Hakyll +import Hakyll ( MonadMetadata, Identifier + , Item, itemIdentifier, field + , getMetadata, lookupString, listField + , toFilePath, Metadata, Compiler, Context + , splitAll) import System.FilePath ( dropExtensions , splitDirectories , takeBaseName) import Data.Maybe ( fromMaybe) import qualified Data.Map as M +import Data.Default (Default (..)) +-- | Configuration for allowing variation of collection and +-- item tags in dependency of the hierarchical directory level. +-- The level count begins with zero. +data Configuration = Configuration + { + -- | begin of item tag, default returns '
  • ' + beginItemTag :: Int -> String + -- | end of item tag, default returns '
    • ' + , endItemTag :: Int -> String + -- | begin of collection tag, default returns '' if level > 0 + , endCollectionTag :: Int -> String + } +instance Default Configuration where + def = defaultConfiguration + +-- | Default configuration for dirListField +defaultConfiguration :: Configuration +defaultConfiguration = Configuration + { beginItemTag = \_ -> "
  • " + , endItemTag = \_ -> "
    • " + , beginCollectionTag = \l -> if l > 0 then "" else "" + } + +-- | Read Configuration from Metadata +-- the given default Configuration is used +-- if no coresponding metadata field is found. +-- The fields are: beginItemTag, endItemTag, +-- beginCollectionTag, endCollectionTag +-- These fields can hold a list of tags which are +-- separated by the value of the field tagDelimiter, +-- or if not given an ','. The list holds the +-- tags per level, if level is higher than the +-- tags in the list the last tag is used. +-- +metadataConfiguration :: Metadata -> Configuration -> Configuration +metadataConfiguration md default' = + Configuration + ( f "beginItemTag" ( beginItemTag default' ) ) + ( f "endItemTag" ( endItemTag default' ) ) + ( f "beginCollectionTag" ( beginCollectionTag default' ) ) + ( f "endCollectionTag" ( endCollectionTag default' ) ) + where + del = fromMaybe "," (lookupString "tagDelimiter" md) + f :: String -> ( Int -> String ) -> ( Int -> String ) + f tag df = + case lookupString tag md of + Nothing -> df + Just s -> g ( splitAll del s ) + g :: [String] -> Int -> String + g (x:[]) _ = x + g (x:_) 0 = x + g (_:xs) l = g xs (l - 1) + g [] _ = "" -- this should not happen + -- | Sort pages alphabetically. alphabetical :: MonadMetadata m => [Item a] -> m [Item a] alphabetical = @@ -102,31 +167,41 @@ -- | pid btags etags data TreeContext = TreeContext String String String deriving Show -getItemTreeAList :: ItemTree a -> Int -> String -> String -> [(Item a, TreeContext)] -getItemTreeAList ( ItemTree i [] pid _ ) _ btags etags = - [( i, TreeContext pid (btags ++ "
  • ") ("
    • " ++ etags))] -getItemTreeAList ( ItemTree i ts pid _ ) level btags etags = - ( i, TreeContext pid (btags ++ "
  • ") "") - : (getItemTreeListAList (level+1) ("
    • " ++ etags) ts) +getItemTreeAList :: Configuration -> ItemTree a -> Int + -> String -> String -> [(Item a, TreeContext)] +getItemTreeAList cfg ( ItemTree i [] pid _ ) level btags etags = + [( i, TreeContext pid (btags ++ (beginItemTag cfg) level) + ((endItemTag cfg) level ++ etags))] +getItemTreeAList cfg ( ItemTree i ts pid _ ) level btags etags = + ( i, TreeContext pid (btags ++ (beginItemTag cfg) level) "") + : (getItemTreeListAList cfg (level+1) ((endItemTag cfg) level ++ etags) ts) +-- +callGetItemTreeListAList :: Configuration -> [ ItemTree a ] + -> [(Item a, TreeContext)] +callGetItemTreeListAList cfg = getItemTreeListAList cfg 0 "" -- -getItemTreeListAList :: Int -> String -> [ ItemTree a ] -> [(Item a, TreeContext)] -getItemTreeListAList _ _ [] = [] -getItemTreeListAList level etags (t:[]) = -- begin + end - getItemTreeAList t level - (if level>0 then "" else "") ++ etags) -getItemTreeListAList level etags (t:ts) = -- begin item - (getItemTreeAList t level (if level>0 then "" else "") ++ etags) ts) +getItemTreeListAList :: Configuration -> Int -> String + -> [ ItemTree a ] -> [(Item a, TreeContext)] +getItemTreeListAList _ _ _ [] = [] +getItemTreeListAList cfg level etags (t:[]) = -- begin + end + getItemTreeAList cfg t level + ((beginCollectionTag cfg) level) + ((endCollectionTag cfg) level ++ etags) +getItemTreeListAList cfg level etags (t:ts) = -- begin item + (getItemTreeAList cfg t level ((beginCollectionTag cfg) level) "") + ++ (getItemTreeListAList' cfg level + ((endCollectionTag cfg) level ++ etags) ts) -- iteration until the end -getItemTreeListAList' :: Int -> String-> [ ItemTree a ] -> [(Item a, TreeContext)] -getItemTreeListAList' _ _ [] = [] -getItemTreeListAList' level etags (t:[]) = -- the last item - getItemTreeAList t level "" etags -getItemTreeListAList' level etags (t:ts) = -- the items in the middle - (getItemTreeAList t level "" "") ++ ( getItemTreeListAList' level etags ts) +getItemTreeListAList' :: Configuration -> Int -> String + -> [ ItemTree a ] -> [(Item a, TreeContext)] +getItemTreeListAList' _ _ _ [] = [] +getItemTreeListAList' cfg level etags (t:[]) = -- the last item + getItemTreeAList cfg t level "" etags +getItemTreeListAList' cfg level etags (t:ts) = -- the items in the middle + ( getItemTreeAList cfg t level "" "") + ++ ( getItemTreeListAList' cfg level etags ts) -- metadata: page-id page-order -- context: full-page-id @@ -175,13 +250,14 @@ directory level, if not given the @page-id@ will be used -} -dirListField :: String -> Context a -> Compiler [Item a] -> Context b -dirListField key c xs = listField key ( c' `mappend` c) pages' +dirListField :: Configuration -> String -> Context a + -> Compiler [Item a] -> Context b +dirListField cfg key c xs = listField key ( c' `mappend` c) pages' where pages = alphabetical =<< xs treeList = (buildOrderedTreeList "") =<< map (\ip-> (fst ip, tail . snd $ ip)) <$> itemPath <$> pages - aList = (getItemTreeListAList 0 "") <$> treeList + aList = callGetItemTreeListAList cfg <$> treeList pages' = (map fst) <$> aList -- the pages in the correct order aList' = map (\(item,ct)->(itemIdentifier item,ct)) <$> aList idMap = M.fromList <$> aList' @@ -195,5 +271,7 @@ ( field "end-tags" ( \i -> ( (\(Just (TreeContext _ _ e))->e) . ( M.lookup (itemIdentifier i) ) ) <$> idMap ) ) - - + + + +