diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +--- +title: Releases +--- + +# Releases + +## hakyll-dir-list 0.1.1.0 +- bump hakyll to 4.11.0.0 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 `
  • ` and `` 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. + + + + diff --git a/hakyll-dir-list.cabal b/hakyll-dir-list.cabal new file mode 100644 --- /dev/null +++ b/hakyll-dir-list.cabal @@ -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 +maintainer: Robert Hennig +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 + + diff --git a/src/Hakyll/Web/Template/DirList.hs b/src/Hakyll/Web/Template/DirList.hs new file mode 100644 --- /dev/null +++ b/src/Hakyll/Web/Template/DirList.hs @@ -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 ++ "
  • ") ("
    • " ++ etags))] +getItemTreeAList ( ItemTree i ts pid _ ) level btags etags = + ( i, TreeContext pid (btags ++ "
  • ") "") + : (getItemTreeListAList (level+1) ("
    • " ++ etags) ts) + +-- +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) + +-- 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 @\@ and @\@ 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 ) ) + +