Complete refactor and restructure. It's way prettier now!

package.yaml

@@ -25,6 +25,7 @@ dependencies:
 - containers  # For Map
 - yaml
 - process
+- exceptions
 
 default-extensions:
 - NoImplicitPrelude
@@ -34,7 +35,7 @@ default-extensions:
 
 executables:
   nebelhorn:
-    main: main.hs
+    main: Main.hs
     source-dirs: src
     ghc-options:
     - -Wall

src/Build.hs

-{-# LANGUAGE QuasiQuotes #-}
-
 module Build (build) where
 
 import ClassyPrelude hiding ((</>))
-import Config
-import File
-import Path
-import System.Process
-import Text.Pandoc
 import qualified Data.Map as Map
-
-{- |
-    A handy nested map function. Works just like the normal inline map '<$>', but nested.
-
-    Example: @(+1) <$$> [[1, 2], [3, 4]]@ evaluates to @[[2, 3], [4, 5]]@.
--}
-(<$$>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
-(<$$>) = fmap . fmap
-
--- | The monadic equivalent of the nested map '<$$>'.
-mapMT :: (Traversable t1, Traversable t2, Monad m) => (a -> m b) -> t1 (t2 a) -> m (t1 (t2 b))
-mapMT = mapM . mapM
+import Text.Pandoc.Definition
+import Text.Pandoc.Class
+import Definition
+import Util
+import Config
+import Load
+import Save
 
 -- | Generate the Pandoc MetaValue for a navbar from a list of NavItem from a Nebelhorn config.
 generateNavbarMeta :: [NavItem] -> MetaValue
@@ -28,87 +16,48 @@ generateNavbarMeta navItems = MetaList $ map f navItems where
     f NavItem{..} = MetaMap $ Map.fromList
         [("name", MetaString $ unpack navItemName), ("link", MetaString $ unpack navItemLink)]
 
--- | Reads in a single document to a Pandoc value using an extra Meta.
-read :: (PandocMonad m, MonadIO m) => Meta -> (Path Rel File, Text) -> m (Path Rel File, Pandoc)
-read (Meta extraMetaMap) (path, content) = do
-    contentR <- read' content
-    -- TODO: This should really be done without IO...
-    newPath <- liftIO $ setFileExtension ".html" path
-    return (newPath, addMeta (Meta $ Map.insert "link" (MetaString $ unpack $ toFilePath newPath) extraMetaMap) contentR)
-    where read' = readMarkdown $ def {readerExtensions = pandocExtensions}
-
--- | Writes a single Pandoc document to HTML5 output using a template.
-write :: (PandocMonad m) => Text -> Pandoc -> m Text
-write template = writeHtml5String writerOptions where
-    writerOptions = def
-        {writerExtensions = pandocExtensions, writerTemplate = Just $ unpack template}
-
--- | Builds a list of pages, using a MetaValue for the navbar, from raw markdown to HTML5.
-buildPages :: (PandocMonad m, MonadIO m)
-    => MetaValue -> [(Path Rel File, Text)] -> m [(Path Rel File, Text)]
-buildPages navbar inputs = do
-    template <- readFileUtf8 "template/page.html"
-    pagesInput <- read extraMeta `mapM` inputs
-
-    write template `mapMT` pagesInput
-
-    where
-        extraMeta = Meta $ Map.fromList [("navbar", navbar)]
-
--- | Builds a list of articles, using a MetaValue for the navbar, from raw markdown to HTML5.
-buildArticles :: (PandocMonad m, MonadIO m)
-    => MetaValue -> [(Path Rel File, Text)] -> m (Text, [(Path Rel File, Text)])
-buildArticles navbar inputs = do
-    templateArticle <- readFileUtf8 "template/article.html"
-    templateIndex <- readFileUtf8 "template/index.html"
-
-    articlesInput' <- sortArticlesPlus <$> read extraMeta `mapM` inputs
-    let neighbors = getNeighbors $ snd <$> articlesInput'
-    -- TODO Refactor!
-    let articlesInput = map (\((prevM, nextM), (path, art)) -> (path, addMeta (Meta $ Map.fromList [("prev", fromMaybe (MetaString "") prevM), ("next", fromMaybe (MetaString "") nextM)]) art)) (zip neighbors articlesInput')
-
-    let indexInput = generateIndex extraMeta (snd <$> articlesInput)
-
-    articlesOutput <- write templateArticle `mapMT` articlesInput
-    indexOutput <- write templateIndex indexInput
-
-    return (indexOutput, articlesOutput)
-
-    where extraMeta = Meta $ Map.fromList [("navbar", navbar)]
+putNavbar :: Nebelhorn -> Nebelhorn
+putNavbar nebelhorn@Nebelhorn{..}
+    = nebelhorn{nebelhornArticles = addMeta "navbar" navbar <$> nebelhornArticles,
+    nebelhornPages = addMeta "navbar" navbar <$> nebelhornPages,
+    nebelhornIndex = addMeta "navbar" navbar nebelhornIndex} where
+        navbar = generateNavbarMeta nebelhornNavItems
 
 -- | 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 = (getLink =<< articles `safeIndex` (n+1), getLink =<< articles `safeIndex` (n-1))
+   f n = (getLinkMeta =<< articles `safeIndex` (n+1), getLinkMeta =<< articles `safeIndex` (n-1))
 
-getLink :: Pandoc -> Maybe MetaValue
-getLink (Pandoc meta _) = lookupMeta "link" meta
-
--- TODO replace with library function
--- | Safely retrieve an item from a list, returning Nothing on failure.
+-- | 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)
 
--- | Generate an index page from a list of Articles.
--- Expects each article to contain a meta value "link" with its link path.
-generateIndex :: Meta -> [Pandoc] -> Pandoc
-generateIndex extraMeta = generateIndex' {- . sortArticles -} where  -- Sorting is done right at the beginning now
-    generateIndex' articles = Pandoc metaOutput [] where
-        metaOutput = extraMeta <> Meta (Map.fromList
-            [("pagetitle", MetaString "Home"), ("articles", MetaList articlesOutput)])
-        articlesOutput = generateIndexMeta <$> articles
+getLinkMeta :: Pandoc -> Maybe MetaValue
+getLinkMeta (Pandoc meta _) = lookupMeta "link" meta
+
+putNeighbors :: Nebelhorn -> Nebelhorn
+putNeighbors nebelhorn@Nebelhorn{..}
+    = nebelhorn{nebelhornArticles = uncurry insertNeighbors <$> zip (getNeighbors nebelhornArticles) nebelhornArticles} where
+        insertNeighbors :: (Maybe MetaValue, Maybe MetaValue) -> Pandoc -> Pandoc
+        insertNeighbors (prevM, nextM)
+            = addMeta "prev" (fromMaybe (MetaString "") prevM)
+            . addMeta "next" (fromMaybe (MetaString "") nextM)
+
+putIndex :: Nebelhorn -> Nebelhorn
+putIndex nebelhorn@Nebelhorn{..} = nebelhorn
+    { nebelhornIndex
+        = addMeta "pagetitle" (MetaString "Home")
+        . addMeta "articles" (MetaList $ generateIndexMeta <$> nebelhornArticles)
+        $ nebelhornIndex
+    }
 
--- TODO only plus is needed, refactor
 -- | Sorts a list of pandocuments by their date meta values.
-sortArticles :: [Pandoc] -> [Pandoc]
-sortArticles = sortOn (Down . (\(Pandoc meta _) -> lookupMeta "date" meta))
-
-sortArticlesPlus :: [(a, Pandoc)] -> [(a, Pandoc)]
-sortArticlesPlus = sortOn (Down . (\(_, (Pandoc meta _)) -> lookupMeta "date" meta))
+sortArticles :: Nebelhorn -> Nebelhorn
+sortArticles nebelhorn@Nebelhorn{..} = nebelhorn{nebelhornArticles = sortOn (Down . (\(Pandoc meta _) -> lookupMeta "date" meta)) nebelhornArticles}
 
 -- | Generates the Pandoc MetaMap for a document for the index page.
 -- It contains the meta of the source, the link and the body.
@@ -116,39 +65,5 @@ generateIndexMeta :: Pandoc -> MetaValue
 generateIndexMeta (Pandoc (Meta metaMap) body) = MetaMap $ metaMap
     <> Map.fromList [("body", MetaBlocks body)]
 
--- | Adds a Meta block to a pandocument. Already known keys are overwritten.
-addMeta :: Meta -> Pandoc -> Pandoc
-addMeta (Meta metaMapExtra) (Pandoc (Meta metaMap) blocks)
-    = Pandoc (Meta $ metaMapExtra `Map.union` metaMap) blocks
-
--- | Compile the stylesheet using sassc.
-compileStylesheet :: IO ()
-compileStylesheet = callCommand "sassc -m style/stylesheet.scss out/style/stylesheet.css"
-
-build :: IO ()
-build = loadConfig >>= \case
-    Left ex -> fail $ "Error while reading config: " <> show ex
-    Right Config{..} -> do
-        copyFolders configFoldersToCopy configOutputFolder
-        compileStylesheet
-
-        articlesInput <- prependPath <$$> load [reldir|article|]
-        pagesInput <- load [reldir|page|]
-
-        articlesOutputE <- runIO (buildArticles (generateNavbarMeta configNavbar) articlesInput)
-        pagesOutputE <- runIO (buildPages (generateNavbarMeta configNavbar) pagesInput)
-
-        let outputE = do{
-            (indexOutput, articlesOutput) <- articlesOutputE;
-            pagesOutput <- pagesOutputE;
-            return (indexOutput, articlesOutput, pagesOutput)}
-
-        case outputE of
-            Left ex -> fail $ "Error while processing articles: " <> show ex
-            Right (indexOutput, articlesOutput, pagesOutput) -> do
-                save configOutputFolder articlesOutput
-                save configOutputFolder pagesOutput
-                save configOutputFolder [([relfile|index.html|], indexOutput)]
-                putStrLn "Success!"
-
-    where prependPath (path, pandoc) = ([reldir|article|] </> path, pandoc)
+build :: (PandocMonad m, MonadIO m) => Config -> m ()
+build config = (putIndex . putNavbar . putNeighbors . sortArticles <$> load config) >>= save

src/Config.hs

@@ -7,9 +7,12 @@ import Data.Yaml
 import Path
 
 data Config = Config {
-    configOutputFolder :: Path Rel Dir,
-    configArticleFolder :: Path Rel Dir,
-    configPageFolder :: Path Rel Dir,
+    configFolderOutput :: Path Rel Dir,
+    configFolderArticle :: Path Rel Dir,
+    configFolderPage :: Path Rel Dir,
+    configTemplateArticle :: Path Rel File,
+    configTemplatePage :: Path Rel File,
+    configTemplateIndex :: Path Rel File,
     configFoldersToCopy :: [Path Rel Dir],
     configNavbar :: [NavItem]
 } deriving (Show)
@@ -21,9 +24,12 @@ data NavItem = NavItem {
 
 instance FromJSON Config where
     parseJSON = withObject "Config" $ \v -> Config
-        <$> v .:? "outputFolder" .!= [reldir|out|]
-        <*> v .:? "articleFolder" .!= [reldir|article|]
-        <*> v .:? "pageFolder" .!= [reldir|page|]
+        <$> v .:? "folderOutput" .!= [reldir|out|]
+        <*> v .:? "folderArticle" .!= [reldir|article|]
+        <*> v .:? "folderPage" .!= [reldir|page|]
+        <*> v .:? "templateArticle" .!= [relfile|template/article.html|]
+        <*> v .:? "templatePage" .!= [relfile|template/page.html|]
+        <*> v .:? "templateIndex" .!= [relfile|template/index.html|]
         <*> v .:? "foldersToCopy" .!= []
         <*> v .:? "navbar" .!= [NavItem "Home" "/index.html"]
 

src/Definition.hs

+module Definition where
+
+import ClassyPrelude
+import Path
+import Config
+import Text.Pandoc.Definition
+
+data Nebelhorn = Nebelhorn {
+    nebelhornFolderOutput :: Path Rel Dir,
+    nebelhornFoldersToCopy :: [Path Rel Dir],
+    nebelhornNavItems :: [NavItem],
+    nebelhornArticles :: [Pandoc],
+    nebelhornPages :: [Pandoc],
+    nebelhornIndex :: Pandoc,
+    nebelhornTemplateArticle :: String,
+    nebelhornTemplatePage :: String,
+    nebelhornTemplateIndex :: String
+}

src/File.hs

-module File (load, save, copyFolders) where
-
-import ClassyPrelude hiding ((</>))
-import Path
-import Path.IO
-
--- | 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"
-    where ext = fileExtension path
-
--- | Reads all markdown files from a folder recursively,
--- returning their contents and paths (relative to the folder path).
-load :: MonadIO m => Path b Dir -> m [(Path Rel File, Text)]
-load basePath = do
-    (_, filesAll) <- listDirRecurRel basePath
-    let files = filter isMarkdownFile filesAll
-    contents <- liftIO $ readFileUtf8 `mapM` (toFilePath . (basePath </>) <$> files)
-    return $ zip files contents
-
--- | Saves a list of files to the specified paths relative to a base path.
-save :: (MonadIO m) => Path b Dir -> [(Path Rel File, Text)] -> m ()
-save basePath = mapM_ $ \(path, output) -> do
-    let fileOutput = basePath </> path
-    ensureDir $ parent fileOutput
-    writeFileUtf8 (toFilePath fileOutput) output
-
--- | Copies folders verbatim according to the target folder.
-copyFolders :: [Path Rel Dir] -> Path a Dir -> IO ()
-copyFolders sources sink = forM_ sources $ \source -> copyDirRecur source (sink </> source)

src/Load.hs

+module Load (load) where
+
+import ClassyPrelude hiding ((</>))
+import qualified Data.Map.Strict as Map
+import Path
+import Path.IO
+import Text.Pandoc.Readers.Markdown
+import Text.Pandoc.Definition
+import Text.Pandoc.Class
+import Text.Pandoc.Options
+import Definition
+import Config
+import Util
+
+-- | Reads in a Nebelhorn value using a config.
+load :: (PandocMonad m, MonadIO m) => Config -> m Nebelhorn
+load Config{..} = Nebelhorn
+    <$> return configFolderOutput
+    <*> return configFoldersToCopy
+    <*> return configNavbar
+    <*> (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))
+
+prependPath :: Path a Dir -> (Path Rel b, t) -> (Path a b, t)
+prependPath basePath (path, x) = (basePath </> path, x)
+
+-- | Puts a path into the meta values of a pandocument.
+linkIntoMeta :: Path a File -> Pandoc -> Pandoc
+linkIntoMeta link (Pandoc (Meta metaMap) bs)
+    = Pandoc (Meta $ Map.insert "link" (MetaString $ toFilePath link) metaMap) bs
+
+-- | Reads all markdown files from a folder recursively,
+-- returning their contents and paths (relative to the folder path).
+readFolder :: (MonadIO m, PandocMonad m) => Path b Dir -> m [(Path Rel File, Pandoc)]
+readFolder basePath = do
+    (_, filesAll) <- listDirRecurRel basePath
+    let files = filter isMarkdownFile filesAll
+    contents <- readFileUtf8 `mapM` (toFilePath . (basePath </>) <$> files)
+    docs <- readMarkdown opts `mapM` contents
+    files' <- liftIO $ setFileExtension ".html" `mapM` files
+    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"
+    where ext = fileExtension path

src/Main.hs

+module Main where
+
+import ClassyPrelude hiding ((</>))
+import System.Process
+import Text.Pandoc.Class
+import Config
+import Build
+
+main :: IO ()
+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!"

src/Save.hs

+{-# LANGUAGE QuasiQuotes #-}
+
+module Save where
+
+import ClassyPrelude hiding ((</>))
+import Path
+import Path.IO
+import Text.Pandoc.Writers.HTML
+import Text.Pandoc.Class
+import Text.Pandoc.Definition
+import Text.Pandoc.Options
+import Definition
+
+save :: (PandocMonad m, MonadIO m) => Nebelhorn -> m ()
+save Nebelhorn{..} = do
+    writeDocument nebelhornTemplateArticle nebelhornFolderOutput `mapM_` nebelhornArticles
+    writeDocument nebelhornTemplatePage nebelhornFolderOutput `mapM_` nebelhornPages
+    writeDocument nebelhornTemplateIndex nebelhornFolderOutput nebelhornIndex
+    liftIO $ copyFolders nebelhornFoldersToCopy nebelhornFolderOutput
+
+
+-- | Saves a list of files to the specified paths relative to a base path.
+writeDocument :: (PandocMonad m, MonadIO m) => String -> Path b Dir -> Pandoc -> m ()
+writeDocument template basePath doc = do
+    let fileOutput = basePath </> fromMaybe [relfile|unknown|] (getLink doc)
+    ensureDir $ parent fileOutput
+    output <- writeHtml5String writerOptions doc
+    writeFileUtf8 (toFilePath fileOutput) output
+    where writerOptions = def{writerExtensions = pandocExtensions, writerTemplate = Just $ unpack template}
+
+-- | Copies folders verbatim according to the target folder.
+copyFolders :: [Path Rel Dir] -> Path a Dir -> IO ()
+copyFolders sources sink = forM_ sources $ \source -> copyDirRecur source (sink </> source)
+
+getLink :: Pandoc -> Maybe (Path Rel File)
+getLink (Pandoc meta _) = lookupMeta "link" meta >>= \(MetaString link) -> parseRelFile link

src/Util.hs

+-- | This module contains utility functions.
+module Util where
+
+import ClassyPrelude
+import Text.Pandoc.Definition
+import qualified Data.Map.Strict as Map
+
+{- |
+    A handy nested map function. Works just like the normal inline map '<$>', but nested.
+
+    Example: @(+1) <$$> [[1, 2], [3, 4]]@ evaluates to @[[2, 3], [4, 5]]@.
+-}
+infixr 5 <$$>
+(<$$>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
+(<$$>) = fmap . fmap
+
+-- | The monadic equivalent of the nested map '<$$>'.
+mapMT :: (Traversable t1, Traversable t2, Monad m) => (a -> m b) -> t1 (t2 a) -> m (t1 (t2 b))
+mapMT = mapM . mapM
+
+-- | Adds a key-metavalue pair to a pandocument. Already known keys are overwritten.
+addMeta :: String -> MetaValue -> Pandoc -> Pandoc
+addMeta key value (Pandoc (Meta metaMap) bs)
+    = Pandoc (Meta $ Map.insert key value metaMap) bs

src/main.hs

-import ClassyPrelude
-import Build
-
-main :: IO ()
-main = build