{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Hakyll.Web.Template.DirList ( dirListField ) where --import Data.Monoid (mappend) import Control.Monad (liftM) import Data.List (sortBy) import Data.Ord (comparing) import Hakyll import System.FilePath ( dropExtensions , splitDirectories , takeBaseName) import Data.Maybe ( fromMaybe) import qualified Data.Map as M -- | Sort pages alphabetically. alphabetical :: MonadMetadata m => [Item a] -> m [Item a] alphabetical = sortByM $ getItemPath . itemIdentifier where sortByM :: (Monad m, Ord k) => (a -> m k) -> [a] -> m [a] sortByM f xs = liftM (map fst . sortBy (comparing snd)) $ mapM (\x -> liftM (x,) (f x)) xs -- | get the path of the item getItemPath :: MonadMetadata m => Identifier -- ^ Input page -> m FilePath -- ^ Parsed UTCTime getItemPath id' = return $ toFilePath id' -- | page-id order data ItemTree a = ItemTree (Item a) [ItemTree a] String String type ItemPath a = ( Item a, [FilePath]) itemPath :: [ Item a] -> [ ItemPath a] itemPath = map (\i -> ( i, splitDirectories . dropExtensions . toFilePath . itemIdentifier $ i) ) -- | get all files which belonging to one tree -- this means the first file name (without extensions) is -- equal to the base name of the following items. -- return theses and the rest of the list getTreeFiles :: [ ItemPath a] -> ( [ItemPath a], [ItemPath a]) getTreeFiles [] = ( [], []) getTreeFiles (p:ps) | (length $ snd p) > 1 = getTreeFiles ps -- drop directories without -- an leading file of the same name | otherwise = getTreeFiles' ( head . snd $ p ) ([],p:ps) -- | baseName TreeFiles Rest getTreeFiles' :: FilePath -> ([ItemPath a], [ItemPath a]) -> ( [ItemPath a], [ItemPath a]) getTreeFiles' _ ( ts, [] ) = ( ts, []) getTreeFiles' a ( ts, p:ps ) | (head $ snd p ) == a = getTreeFiles' a ( ts ++ [p] , ps) | otherwise = ( ts, p:ps ) -- | build the tree, the input are only files belonging to this tree -- | key is the order buildTree :: MonadMetadata m => String -> [ItemPath a] -> m (ItemTree a) buildTree parentPid (p:ps) = do pid <- getItemPageId id' ord <- getItemPageOrder id' tl <- buildOrderedTreeList (parentPid' ++ pid) ( map (\x->(fst x, tail $ snd x)) ps) return $ ItemTree (fst p) tl (parentPid' ++ pid) ord where id' = itemIdentifier $ fst p parentPid' = if parentPid == "" then "" else parentPid ++ "-" buildTree _ [] = error "buildTree: empty file list" -- -- | build the tree, the input are only files belonging to this tree -- -- | key is the order -- buildTree :: MonadMetadata m => String -> [Iid <- getItemPageId id -- ord <- getItemPageOrder id -- tl <- buildOrderedTreeList (parentPid' ++ pid) ( map (\x->(fst x, tail $ snd x)) ps) -- return $ ItemTree (fst p) tl (parentPid' ++ pid) ord -- where -- id = itemIdentifier $ fst p -- parentPid' = if parentPid == "" then "" else parentPid ++ "-" -- | build tree list buildTreeList :: MonadMetadata m => String -> [ItemPath a] -> m [ItemTree a] buildTreeList _ [] = return [] buildTreeList parentPid ps = do t <- buildTree parentPid ts tl <- buildTreeList parentPid rs return $ t : tl where ( ts, rs) = getTreeFiles ps -- | sort the treeList buildOrderedTreeList :: MonadMetadata m => String -> [ItemPath a] -> m [ItemTree a] buildOrderedTreeList _ [] = return [] buildOrderedTreeList parentPid ps = do tl <- buildTreeList parentPid ps return $ sortBy (comparing (\( ItemTree _ _ _ o)-> o)) tl -- | 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 ++ "