hakyll-dir-list (empty) → 0.1.1.0
raw patch · 5 files changed
+306/−0 lines, 5 filesdep +basedep +containersdep +filepath
Dependencies added: base, containers, filepath, hakyll
Files
- CHANGELOG.md +8/−0
- LICENSE +29/−0
- README.md +33/−0
- hakyll-dir-list.cabal +37/−0
- src/Hakyll/Web/Template/DirList.hs +199/−0
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+---+title: Releases+---++# Releases++## hakyll-dir-list 0.1.1.0+- bump hakyll to 4.11.0.0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2017, freylax+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,33 @@+# hakyll-dir-list+[Hakyll](https://jaspervdj.be/hakyll/)+extension which supports the creation of hierarchical menus from source files in a directory structure.+Adittionally single page web sites can created by using flattened page id's instead of urls.++## Build the library+* `stack build`++## Usage++The exported `dirListField` function is similar to the Hakyll [`listField`](https://jaspervdj.be/hakyll/reference/Hakyll-Web-Template-Context.html#v:listField)+template function but creates additional context information which can be used in the template to create a hierarchical menu.+### Context usable inside the template +* `$begin-tags$` injects `<li>` and `<ul>` tags if apropriate+* `$end-tags$` contains the corresponding `</li>` and `</ul>` tags+* `$full-page-id$` is the hyphen seperated path of the page+### 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:+* `pages/a.md` top page for directory a+* `pages/a/foo.md` page foo within a+++The following meta information can be given+* `page-id` part of the generated id, if not given the base name of the file+* `page-order` give an ordering key for sorting in the current directory level, if not given the `page-id` will be used++## Example+See the example for an illustration of usage.+++ +
+ hakyll-dir-list.cabal view
@@ -0,0 +1,37 @@+name: hakyll-dir-list+version: 0.1.1.0++synopsis: Allow Hakyll to create hierarchical menues from directories. ++description:+ Hakyll extension which supports the creation of hierarchical+ menus from source files in a directory structure.+ Adittionally single page web sites can created by using flattened+ page id's instead of urls.++author: Robert Hennig <robert.hennig@freylax.de>+maintainer: Robert Hennig <robert.hennig@freylax.de>+homepage: http://github.com/freylax/hakyll-dir-list+bug-reports: http://github.com/freylax/hakyll-dir-list/issues+license: BSD3+license-file: LICENSE+category: Web+ +build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md CHANGELOG.md + +library+ exposed-modules:+ Hakyll.Web.Template.DirList+ build-depends: base == 4.*+ , hakyll == 4.11.*+ , filepath+ , containers+ hs-source-dirs: src+ Ghc-options: -Wall+ default-language: Haskell2010++
+ src/Hakyll/Web/Template/DirList.hs view
@@ -0,0 +1,199 @@+{-# 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 ++ "<li>") ("</li>" ++ etags))]+getItemTreeAList ( ItemTree i ts pid _ ) level btags etags =+ ( i, TreeContext pid (btags ++ "<li>") "")+ : (getItemTreeListAList (level+1) ("</li>" ++ etags) ts)++-- +getItemTreeListAList :: Int -> String -> [ ItemTree a ] -> [(Item a, TreeContext)]+getItemTreeListAList _ _ [] = []+getItemTreeListAList level etags (t:[]) = -- begin + end+ getItemTreeAList t level+ (if level>0 then "<ul>" else "")+ ((if level>0 then "</ul>" else "") ++ etags) +getItemTreeListAList level etags (t:ts) = -- begin item+ (getItemTreeAList t level (if level>0 then "<ul>" else "") "")+ ++ (getItemTreeListAList' level ((if level>0 then "</ul>" else "") ++ 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)+ +-- metadata: page-id page-order+-- context: full-page-id++getItemPageId :: MonadMetadata m => Identifier -> m String+getItemPageId id' = do+ metadata <- getMetadata id'+ return $ fromMaybe+ ( takeBaseName $ toFilePath id' )+ ( lookupString "page-id" metadata )++getItemPageOrder :: MonadMetadata m => Identifier -> m String+getItemPageOrder id' = do+ metadata <- getMetadata id'+ pageId <- getItemPageId id'+ return $ fromMaybe pageId ( lookupString "page-order" metadata)++{-|+ The exported 'dirListField' function is similar to the+ 'Hakyll.Web.Template.listField' template function but creates+ additional context information which can be used in the template+ to create a hierarchical menu.++ == Context usable inside the template ++ [@$begin-tags$@]: injects @\<li\>@ and @\<ul\>@ tags if apropriate++ [@$end-tags$@]: contains the corresponding @\<\/li\>@ and @\<\/ul\>@ tags++ [@$full-page-id$@]: is the hyphen seperated path of the page++ == 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:++ [@pages\/a.md@]: top page for directory a++ [@pages\/a\/foo.md@]: page foo within a++ The following meta information can be given++ [@page-id@]: part of the generated id, if not given the base name of the file++ [@page-order@]: give an ordering key for sorting in the current+ 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' + where+ pages = alphabetical =<< xs+ treeList = (buildOrderedTreeList "") =<<+ map (\ip-> (fst ip, tail . snd $ ip)) <$> itemPath <$> pages+ aList = (getItemTreeListAList 0 "") <$> treeList+ pages' = (map fst) <$> aList -- the pages in the correct order+ aList' = map (\(item,ct)->(itemIdentifier item,ct)) <$> aList+ idMap = M.fromList <$> aList'+ c' = -- ( field "test" ( \i -> M.showTree <$> idMap) ) `mappend`+ ( field "full-page-id"+ ( \i -> ( (\(Just (TreeContext pid _ _))->pid)+ . ( M.lookup (itemIdentifier i) ) ) <$> idMap ) ) `mappend`+ ( field "begin-tags"+ ( \i -> ( (\(Just (TreeContext _ b _))->b)+ . ( M.lookup (itemIdentifier i) ) ) <$> idMap ) ) `mappend`+ ( field "end-tags"+ ( \i -> ( (\(Just (TreeContext _ _ e))->e)+ . ( M.lookup (itemIdentifier i) ) ) <$> idMap ) )+ +