Draft a data structure for pages and make it part of the Blog datastructure

This commit is contained in:
Tissevert 2019-08-27 16:49:47 +02:00
parent b080c32d4c
commit 46daaa2b7a
3 changed files with 32 additions and 13 deletions

View file

@ -41,6 +41,7 @@ executable hablo
, HTML
, JS
, JSON
, Page
, Paths_hablo
, Pretty
-- other-extensions:

View file

@ -27,16 +27,20 @@ import Data.Set (Set)
import qualified Data.Set as Set (empty, null, singleton, union)
import Files (File(..), absolute)
import qualified Files (find)
import Page (Page)
import qualified Page (at)
import Prelude hiding (lookup)
import System.Directory (doesFileExist, withCurrentDirectory)
import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
import Text.Parsec (ParseError)
type Collection = Map String Article
type Collection = Map String
type Parsed a = Either ParseError (String, a)
data Blog = Blog {
articles :: Collection
articles :: Collection Article
, name :: String
, pages :: Collection Page
, path :: Path
, skin :: Skin
, tags :: Map String (Set String)
@ -46,25 +50,25 @@ data Blog = Blog {
get :: MonadReader Blog m => (Blog -> a) -> m a
get = (<$> ask)
keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article)
keepOrWarn :: Collection a -> Parsed a -> IO (Collection a)
keepOrWarn accumulator (Left parseErrors) =
forM [show parseErrors, "=> Ignoring this article"] putStrLn
forM [show parseErrors, "=> Ignoring this text"] putStrLn
>> return accumulator
keepOrWarn accumulator (Right (key, article)) =
return $ insert key article accumulator
findArticles :: FilePath -> IO (Map String Article)
findArticles =
find :: (FilePath -> IO (Parsed a)) -> FilePath -> IO (Collection a)
find parser =
Files.find
>=> filterM isMarkDownFile
>=> mapM Article.at
>=> mapM parser
>=> foldM keepOrWarn Map.empty
where
isMarkDownFile path = do
let correctExtension = takeExtension path == ".md"
(correctExtension &&) <$> doesFileExist path
tagged :: Collection -> FilePath -> IO (String, Set String)
tagged :: Collection Article -> FilePath -> IO (String, Set String)
tagged collection path = do
links <- Files.find path
keys <- forM links $ \link -> do
@ -75,12 +79,13 @@ tagged collection path = do
else Set.empty
return (takeFileName path, foldl Set.union Set.empty keys)
discover :: Path -> IO (Collection, Map String (Set String))
discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String))
discover path = do
articles <- findArticles $ articlesPath path
articles <- find (Article.at) $ articlesPath path
pages <- maybe (return Map.empty) (find (Page.at)) $ pagesPath path
tags <- Map.fromList . filter (not . Set.null . snd)
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
return (articles, tags)
return (articles, pages, tags)
build :: Arguments -> IO Blog
build arguments = do
@ -91,5 +96,5 @@ build arguments = do
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
$ Arguments.name arguments
skin <- Skin.build name arguments
(articles, tags) <- discover path
return $ Blog {articles, name, path, skin, tags, wording}
(articles, pages, tags) <- discover path
return $ Blog {articles, name, pages, path, skin, tags, wording}

13
src/Page.hs Normal file
View file

@ -0,0 +1,13 @@
module Page (
Page(..)
, at
) where
import Text.ParserCombinators.Parsec (ParseError)
data Page = Page {
title :: String
}
at :: FilePath -> IO (Either ParseError (String, Page))
at = undefined