Draft a data structure for pages and make it part of the Blog datastructure
This commit is contained in:
parent
b080c32d4c
commit
46daaa2b7a
3 changed files with 32 additions and 13 deletions
|
@ -41,6 +41,7 @@ executable hablo
|
|||
, HTML
|
||||
, JS
|
||||
, JSON
|
||||
, Page
|
||||
, Paths_hablo
|
||||
, Pretty
|
||||
-- other-extensions:
|
||||
|
|
31
src/Blog.hs
31
src/Blog.hs
|
@ -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
13
src/Page.hs
Normal 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
|
Loading…
Reference in a new issue