Commit 37f4c074 authored by Nicolas Lenz's avatar Nicolas Lenz

Comments, Refactoring, ignore noIndex

parent b14ee919
Pipeline #242 passed with stage
in 14 minutes and 37 seconds
......@@ -16,6 +16,7 @@ generateNavbarMeta navItems = MetaList $ map f navItems where
f NavItem{..} = MetaMap $ Map.fromList
[("name", MetaString $ unpack navItemName), ("link", MetaString $ unpack navItemLink)]
-- Puts the navbar into all documents of a Nebelhorn.
putNavbar :: Nebelhorn -> Nebelhorn
putNavbar nebelhorn@Nebelhorn{..}
= nebelhorn{nebelhornArticles = addMeta "navbar" navbar <$> nebelhornArticles,
......@@ -26,35 +27,38 @@ putNavbar nebelhorn@Nebelhorn{..}
-- | Gets the previous and next neigbors for each article in the list. This only works if every pandocument has the link meta value set.
getNeighbors :: [Pandoc] -> [(Maybe MetaValue, Maybe MetaValue)]
getNeighbors articles = f <$> [0..(length articles - 1)] where
-- Index + 1 is previous as the newest is first in the list
f n = (getLinkMeta =<< articles `safeIndex` (n+1), getLinkMeta =<< articles `safeIndex` (n-1))
-- | Safely retrieve an item from a list, returning Nothing on failure. Mostly equivalent to Data.Key.lookup, but returns Nothing on negative numbers which I rely on.
safeIndex :: [a] -> Int -> Maybe a
safeIndex [] _ = Nothing
safeIndex _ n | n < 0 = Nothing
safeIndex (x:_) 0 = Just x
safeIndex (_:xs) n = safeIndex xs (n-1)
getLinkMeta :: Pandoc -> Maybe MetaValue
getLinkMeta (Pandoc meta _) = lookupMeta "link" meta
f n = (getLinkMeta =<< articles `safeIndex` (n-1), getLinkMeta =<< articles `safeIndex` (n+1))
-- | Puts prev and next tags into all articles. Articles not for index are ignored, and also put in front of the list, which is okay as they're not put on the index page anyway.
putNeighbors :: Nebelhorn -> Nebelhorn
putNeighbors nebelhorn@Nebelhorn{..}
= nebelhorn{nebelhornArticles = uncurry insertNeighbors <$> zip (getNeighbors nebelhornArticles) nebelhornArticles} where
= nebelhorn{nebelhornArticles = (<>) excludedArticles $ uncurry insertNeighbors <$> zip (getNeighbors articles) articles} where
articles = filter isForIndex nebelhornArticles
excludedArticles = filter (not . isForIndex) nebelhornArticles
insertNeighbors :: (Maybe MetaValue, Maybe MetaValue) -> Pandoc -> Pandoc
insertNeighbors (prevM, nextM)
insertNeighbors (nextM, prevM)
= addMeta "prev" (fromMaybe (MetaString "") prevM)
. addMeta "next" (fromMaybe (MetaString "") nextM)
-- | Retrieves the link meta value from a pandocument.
getLinkMeta :: Pandoc -> Maybe MetaValue
getLinkMeta (Pandoc meta _) = lookupMeta "link" meta
-- | Populates the index page in a Nebelhorn.
putIndex :: Nebelhorn -> Nebelhorn
putIndex nebelhorn@Nebelhorn{..} = nebelhorn
{ nebelhornIndex
= addMeta "pagetitle" (MetaString "Home")
. addMeta "articles" (MetaList $ generateIndexMeta <$> nebelhornArticles)
. addMeta "articles" (MetaList $ generateIndexMeta <$> filter isForIndex nebelhornArticles)
$ nebelhornIndex
}
-- | Checks whether a pandocument should be included or set as noIndex.
isForIndex :: Pandoc -> Bool
isForIndex (Pandoc meta _) = case lookupMeta "noIndex" meta of
Just (MetaBool True) -> False
_ -> True
-- | Sorts a list of pandocuments by their date meta values.
sortArticles :: Nebelhorn -> Nebelhorn
sortArticles nebelhorn@Nebelhorn{..} = nebelhorn{nebelhornArticles = sortOn (Down . (\(Pandoc meta _) -> lookupMeta "date" meta)) nebelhornArticles}
......@@ -65,5 +69,6 @@ generateIndexMeta :: Pandoc -> MetaValue
generateIndexMeta (Pandoc (Meta metaMap) body) = MetaMap $ metaMap
<> Map.fromList [("body", MetaBlocks body)]
-- Builds a Nebelhorn page according to a config.
build :: (PandocMonad m, MonadIO m) => Config -> m ()
build config = (putIndex . putNavbar . putNeighbors . sortArticles <$> load config) >>= save
......@@ -6,6 +6,7 @@ import ClassyPrelude
import Data.Yaml
import Path
-- | A nebelhorn config.
data Config = Config {
configFolderOutput :: Path Rel Dir,
configFolderArticle :: Path Rel Dir,
......
......@@ -5,6 +5,7 @@ import Path
import Config
import Text.Pandoc.Definition
-- | The Nebelhorn type.
data Nebelhorn = Nebelhorn {
nebelhornFolderOutput :: Path Rel Dir,
nebelhornFoldersToCopy :: [Path Rel Dir],
......@@ -14,5 +15,6 @@ data Nebelhorn = Nebelhorn {
nebelhornIndex :: Pandoc,
nebelhornTemplateArticle :: String,
nebelhornTemplatePage :: String,
nebelhornTemplateIndex :: String
nebelhornTemplateIndex :: String,
nebelhornStylesheet :: String
}
{-# LANGUAGE QuasiQuotes #-}
module Load (load) where
import ClassyPrelude hiding ((</>))
......@@ -18,13 +20,15 @@ load Config{..} = Nebelhorn
<$> return configFolderOutput
<*> return configFoldersToCopy
<*> return configNavbar
<*> (uncurry linkIntoMeta <$$> prependPath configFolderArticle <$$> readFolder configFolderArticle)
<*> (uncurry linkIntoMeta <$$> readFolder configFolderPage)
<*> uncurry linkIntoMeta <$$> prependPath configFolderArticle <$$> readFolder configFolderArticle
<*> uncurry linkIntoMeta <$$> readFolder configFolderPage
<*> return (Pandoc (Meta $ Map.singleton "link" $ MetaString "index.html") [])
<*> (unpack <$> readFileUtf8 (toFilePath configTemplateArticle))
<*> (unpack <$> readFileUtf8 (toFilePath configTemplatePage))
<*> (unpack <$> readFileUtf8 (toFilePath configTemplateIndex))
<*> return "style/stylesheet.scss" -- TODO make configurable
-- | Prepend a path to a path inside a tuple.
prependPath :: Path a Dir -> (Path Rel b, t) -> (Path a b, t)
prependPath basePath (path, x) = (basePath </> path, x)
......@@ -45,8 +49,6 @@ readFolder basePath = do
return $ zip files' docs
where opts = def {readerExtensions = pandocExtensions}
-- | Predicate that checks whether a file is a markdown file using the file extension.
isMarkdownFile :: Path b File -> Bool
isMarkdownFile path = ext == ".md" || ext == ".markdown"
......
{-# LANGUAGE QuasiQuotes #-}
module Main where
import ClassyPrelude hiding ((</>))
import System.Process
import Text.Pandoc.Class
import Config
import Build
......@@ -11,6 +12,4 @@ main = loadConfig >>= \case
Left err -> putStrLn $ tshow err
Right config -> runIO (build config) >>= \case
Left err -> putStrLn $ tshow err
Right () -> do
callCommand "sassc -m style/stylesheet.scss out/style/stylesheet.css"
putStrLn "Success!"
Right () -> putStrLn "Success!"
......@@ -5,17 +5,23 @@ module Save where
import ClassyPrelude hiding ((</>))
import Path
import Path.IO
import System.Process
import Text.Pandoc.Writers.HTML
import Text.Pandoc.Class
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Definition
-- | Saves a Nebelhorn.
save :: (PandocMonad m, MonadIO m) => Nebelhorn -> m ()
save Nebelhorn{..} = do
writeDocument nebelhornTemplateArticle nebelhornFolderOutput `mapM_` nebelhornArticles
writeDocument nebelhornTemplatePage nebelhornFolderOutput `mapM_` nebelhornPages
writeDocument nebelhornTemplateIndex nebelhornFolderOutput nebelhornIndex
ensureDir $ nebelhornFolderOutput </> [reldir|style|]
liftIO $ callCommand $ "sassc -m "
<> nebelhornStylesheet <> " "
<> toFilePath (nebelhornFolderOutput </> [relfile|style/stylesheet.css|])
liftIO $ copyFolders nebelhornFoldersToCopy nebelhornFolderOutput
......@@ -32,5 +38,6 @@ writeDocument template basePath doc = do
copyFolders :: [Path Rel Dir] -> Path a Dir -> IO ()
copyFolders sources sink = forM_ sources $ \source -> copyDirRecur source (sink </> source)
-- | Retrieves the link meta value as Path from a pandocument
getLink :: Pandoc -> Maybe (Path Rel File)
getLink (Pandoc meta _) = lookupMeta "link" meta >>= \(MetaString link) -> parseRelFile link
......@@ -22,3 +22,11 @@ mapMT = mapM . mapM
addMeta :: String -> MetaValue -> Pandoc -> Pandoc
addMeta key value (Pandoc (Meta metaMap) bs)
= Pandoc (Meta $ Map.insert key value metaMap) bs
-- | Safely retrieve an item from a list, returning Nothing on failure.
-- Mostly equivalent to Data.Key.lookup, but returns Nothing on negative numbers which I rely on.
safeIndex :: [a] -> Int -> Maybe a
safeIndex [] _ = Nothing
safeIndex _ n | n < 0 = Nothing
safeIndex (x:_) 0 = Just x
safeIndex (_:xs) n = safeIndex xs (n-1)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment