From d1d874d597918ccd8411f8af728f3064f261b560 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Fri, 15 Feb 2019 14:13:43 +0100 Subject: [PATCH] Implement JS navigation --- hablo.cabal | 4 +- js/domRenderer.js | 78 ++++++++++++++++++++++++++++++++++ js/main.js | 11 ++++- js/navigation.js | 106 ++++++++++++++++++++++++++++++++++++++++++++++ src/Article.hs | 86 ++++++++++++++++++++++--------------- src/Blog.hs | 11 ++--- src/Dom.hs | 34 ++++++++------- src/JSON.hs | 19 +++++++-- 8 files changed, 291 insertions(+), 58 deletions(-) create mode 100644 js/domRenderer.js create mode 100644 js/navigation.js diff --git a/hablo.cabal b/hablo.cabal index e8a68e7..d991775 100644 --- a/hablo.cabal +++ b/hablo.cabal @@ -15,7 +15,8 @@ maintainer: tissevert+devel@marvid.fr -- copyright: category: Web extra-source-files: CHANGELOG.md -data-files: js/main.js +build-type: Simple +data-files: js/*.js executable hablo main-is: Main.hs @@ -41,6 +42,7 @@ executable hablo , lucid , mtl , optparse-applicative + , parsec , text , unix ghc-options: -Wall diff --git a/js/domRenderer.js b/js/domRenderer.js new file mode 100644 index 0000000..eff7aea --- /dev/null +++ b/js/domRenderer.js @@ -0,0 +1,78 @@ +function DomRenderer(modules) { + return { + article: article, + articlesList: articlesList, + replaceMarkdown: replaceMarkdown + }; + + function replaceMarkdown() { + var div = document.getElementById('contents'); + if(div.children[0] && div.children[0].tagName.toLowerCase() == 'article') { + convertArticle(div.children[0]); + } else { + var articles = div.getElementsByClassName('articles')[0]; + if(articles != undefined) { + for(var i = 0; i < articles.children.length; i++) { + convertArticle(articles.children[i]); + } + } else { + console.log('No articles found for this page'); + } + } + } + + function convertArticle(article) { + var header = article.getElementsByTagName('header')[0]; + var text = article.getElementsByTagName('pre')[0]; + if(text != undefined) { + article.replaceChild(getDiv(text.innerText), text); + } else { + console.log('No content found for this article'); + } + } + + function getDiv(markdown) { + return modules.dom.make('div', { + innerHTML: modules.md.render(markdown) + }); + } + + function article(url, markdown, limit) { + var headerEnd = markdown.search(/\n\n/); + var header = getDiv(markdown.slice(0, headerEnd)); + var lines = markdown.slice(headerEnd+2).split(/\n/); + var div = getDiv(lines.slice(0, limit).join('\n')); + var title = header.getElementsByTagName('h1')[0]; + return title == undefined ? null : modules.dom.make('article', {}, [ + modules.dom.make('header', {}, [ + modules.dom.make('a', {class: (limit != undefined ? 'navigation' : []), href: url}, [title]) + ]), + div + ]); + } + + function pageTitle(tag, all) { + return (all ? 'All' : 'Latest') + ' articles' + (tag != undefined ? ' tagged ' + tag : ''); + } + + function otherUrl(tag, all) { + var path = [tag, all ? null : 'all.html']; + return '/' + path.filter(modules.fun.defined).join('/'); + } + + function articlesList(tag, all) { + return function(articlePreviews) { + return [ + modules.dom.make('h2', {innerText: pageTitle(tag, all)}), + modules.dom.make('p', {}, [ + modules.dom.make('a', { + class: 'navigation', + innerText: all ? 'See only latest' : 'See all', + href: otherUrl(tag, all) + }) + ]), + modules.dom.make('div', {class: 'articles'}, articlePreviews.filter(modules.fun.defined)) + ]; + }; + } +} diff --git a/js/main.js b/js/main.js index 973d74f..8a3e8d2 100644 --- a/js/main.js +++ b/js/main.js @@ -1,3 +1,12 @@ window.addEventListener('load', function() { - console.log("Hablo loaded"); + var async = unitJS.Async(); + var cache = unitJS.Cache(); + var dom = unitJS.Dom(); + var fun = unitJS.Fun(); + var md = new Remarkable({html: true}); + md.block.ruler.enable(['footnote']); + var domRenderer = DomRenderer({fun: fun, md: md, dom: dom}); + var navigation = Navigation({async: async, cache: cache, fun: fun, md: md, dom: dom, domRenderer: domRenderer}); + domRenderer.replaceMarkdown(); + navigation.hijackLinks(); }); diff --git a/js/navigation.js b/js/navigation.js new file mode 100644 index 0000000..3c18dcc --- /dev/null +++ b/js/navigation.js @@ -0,0 +1,106 @@ +function Navigation(modules) { + var articles = modules.cache.make(function(url) { + return modules.async.bind( + modules.async.http({method: 'GET', url: url}), + function(queryResult) { + if(queryResult.status == 200) { + return modules.async.wrap(queryResult.responseText); + } else { + return modules.async.fail( + "Could not load article " + url + " (" + queryResult.status + " " + queryResult.statusText + ")" + ); + } + } + ); + }); + window.addEventListener('popstate', function(e) {navigate(e.state.url);}); + history.replaceState({url: window.location.pathname}, 'Blog - title', window.location.pathname); + return { + hijackLinks: hijackLinks + }; + + function hijackLinks(domElem) { + domElem = domElem || document; + var links = domElem.getElementsByTagName('a'); + for(var i = 0; i < links.length; i++) { + var a = links[i]; + if(a.classList.contains("navigation")) { + a.addEventListener('click', visit(a.getAttribute("href"))); + } + } + } + + function visit(url) { + return function(e) { + e.preventDefault(); + history.pushState({url: url}, 'Blog - title', url); + navigate(url); + }; + } + + function navigate(url) { + var path = url.split("/").slice(1); + if(blog.tags[path[0]] != undefined) { + show(getArticlesList(path[0], path[1] == "all.html")); + } else if(path[0].length > 0 && !path[0].match(/\.html$/)) { + show(getArticle(url.replace(/html$/, 'md'))); + } else { + show(getArticlesList(null, path[0] == "all.html")); + } + } + + function getArticle(url) { + return modules.async.bind( + articles.get(url), + modules.async.map( + function(contents) {return [modules.domRenderer.article(url, contents)];} + ) + ); + } + + function preview(articleId) { + var source = blog.articles[articleId].source; + return modules.async.bind( + articles.get(source), + function(contents) { + return modules.async.wrap( + modules.domRenderer.article( + source.replace(/md$/, 'html'), + contents, + blog.skin.previewLinesCount + ) + ); + } + ); + } + + function articleIds(tag, all) { + var ids = tag != undefined ? blog.tags[tag] : Object.keys(blog.articles); + ids.sort(function(idA, idB) {return blog.articles[idB].date - blog.articles[idA].date;}); + return ids.slice(0, all ? undefined : blog.skin.previewArticlesCount); + } + + function getArticlesList(tag, all) { + return modules.async.bind( + modules.async.parallel.apply(null, articleIds(tag, all).map(preview)), + modules.async.map(modules.domRenderer.articlesList(tag, all)) + ); + } + + function show(contents) { + modules.async.run( + modules.async.bind( + contents, + modules.async.map(function (domElems) { + domElems = domElems.filter(modules.fun.defined); + var div = document.getElementById('contents'); + modules.dom.clear(div); + for(var i = 0; i < domElems.length; i++) { + div.appendChild(domElems[i]); + } + hijackLinks(div); + }) + ) + ); + } +} diff --git a/src/Article.hs b/src/Article.hs index bc73301..dad92ff 100644 --- a/src/Article.hs +++ b/src/Article.hs @@ -1,53 +1,73 @@ {-# LANGUAGE NamedFieldPuns #-} -{- LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} module Article ( Article(..) , at + , preview + , titleP ) where -import Control.Monad.State (evalState, modify, state) +import Data.Map (Map) +import qualified Data.Map as Map (fromList) import System.FilePath (dropExtension) import System.Posix.Types (FileID) import System.Posix.Files (FileStatus, getFileStatus, fileID) +import Text.ParserCombinators.Parsec ( + ParseError + , Parser + , (<|>) + , anyChar, char, count, endBy, eof, many, many1, noneOf, oneOf, option, parse, skipMany, spaces, string, try + ) data Article = Article { urlPath :: String , fileStatus :: FileStatus , title :: String - , preview :: String - , fullContents :: String + , metadata :: Map String String + , body :: [String] } -getTitle :: [String] -> (String, [String]) -getTitle [] = ("", []) -getTitle (('#':' ':aTitle):rest) = (aTitle, rest) -getTitle (a:b:l) - | length a == length b && (all (== '#') b || all (== '=') b) = (a, b:l) - | otherwise = getTitle (b:l) -getTitle (_:rest) = getTitle rest +articleP :: Parser (String, Map String String, [String]) +articleP = + skipMany eol *> headerP <* skipMany eol <*> (lines <$> many anyChar <* eof) + where + headerP = + try ((,,) <$> titleP <* many eol <*> metadataP) + <|> flip (,,) <$> metadataP <* many eol<*> titleP -parseBegining :: Int -> String -> (String, String) -parseBegining linesCount = evalState (do - theTitle <- state getTitle - modify $ dropWhile $ not . null - modify $ dropWhile null - thePreview <- state $ splitAt linesCount - return (theTitle, unlines thePreview) - ) . lines +metadataP :: Parser (Map String String) +metadataP = Map.fromList <$> option [] ( + metaSectionSeparator *> many eol *> + (try keyVal) `endBy` (many1 eol) + <* metaSectionSeparator + ) + where + metaSectionSeparator = count 3 (oneOf "~-") *> eol + keyVal = (,) <$> (no ": " <* spaces <* char ':' <* spaces) <*> no "\r\n" -at :: Int -> FilePath -> IO (FileID, Article) -at linesCount filePath = do +titleP :: Parser String +titleP = try (singleLine <|> underlined) + where + singleLine = char '#' *> char ' ' *> no "\r\n" <* eol + underlined = + no "\r\n" <* eol + >>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine + +eol :: Parser String +eol = try (string "\r\n") <|> string "\r" <|> string "\n" + +no :: String -> Parser String +no = many1 . noneOf + +at :: FilePath -> IO (Either ParseError (FileID, Article)) +at filePath = do fileStatus <- getFileStatus filePath - fullContents <- readFile filePath - let (title, preview) = parseBegining linesCount fullContents - return ( - fileID fileStatus - , Article { - urlPath = dropExtension filePath - , fileStatus - , title - , preview - , fullContents - } - ) + fmap (makeArticle fileStatus) . parse articleP filePath <$> readFile filePath + where + makeArticle fileStatus (title, metadata, body) = ( + fileID fileStatus + , Article {urlPath = dropExtension filePath, fileStatus, title, body, metadata} + ) +preview :: Int -> Article -> Article +preview linesCount article = article {body = take linesCount $ body article} diff --git a/src/Blog.hs b/src/Blog.hs index c45a4b2..9a4f3fa 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -15,6 +15,7 @@ import Blog.Skin (Skin(..)) import qualified Blog.Skin as Skin (build) import Control.Monad ((>=>), filterM, forM) import Control.Monad.Reader (MonadReader, ask) +import Data.Either (rights) import Data.Map (Map) import qualified Data.Map as Map (fromList, member) import Data.Set (Set) @@ -38,12 +39,12 @@ data Blog = Blog { get :: MonadReader Blog m => (Blog -> a) -> m a get = (<$> ask) -findArticles :: Int -> FilePath -> IO (Map FileID Article) -findArticles linesCount = +findArticles :: FilePath -> IO (Map FileID Article) +findArticles = Files.find >=> filterM isMarkDownFile - >=> mapM (Article.at linesCount) - >=> return . Map.fromList + >=> mapM Article.at + >=> return . Map.fromList . rights where isMarkDownFile path = do let correctExtension = takeExtension path == ".md" @@ -65,7 +66,7 @@ build :: Arguments -> IO Blog build arguments = withCurrentDirectory root $ do let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ Arguments.name arguments skin <- Skin.build name arguments - articles <- findArticles (previewLinesCount skin) articlesPath + articles <- findArticles articlesPath tags <- Map.fromList . filter (not . Set.null . snd) <$> (Files.find (articlesPath "tags") >>= mapM (articles `tagged`)) return $ Blog { diff --git a/src/Dom.hs b/src/Dom.hs index 8df3457..d12f373 100644 --- a/src/Dom.hs +++ b/src/Dom.hs @@ -5,6 +5,7 @@ module Dom ( ) where import Article (Article(..)) +import qualified Article (preview) import ArticlesList (ArticlesList(..), otherLink, otherUrl, pageTitle) import Blog (Blog(..), Skin(..)) import qualified Blog (get) @@ -29,11 +30,7 @@ instance Page Article where ("A new article on " <>) <$> Blog.get name >>= makeCard title - content (Article {fullContents, urlPath}) = - article_ (do - a_ [href_ . pack $ "/" urlPath <.> "md"] "Raw" - pre_ $ toHtml fullContents - ) + content = article True instance Page ArticlesList where card al = do @@ -41,9 +38,23 @@ instance Page ArticlesList where makeCard (maybe blogName ((blogName ++ " - ") ++) $ tagged al) (pageTitle al) content al@(ArticlesList {featured}) = do + preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) h2_ . toHtml . pack $ pageTitle al p_ . navigationA [href_ . pack $ otherUrl al] . toHtml . pack $ otherLink al - div_ [class_ "articles"] (mapM_ previewArticle featured) + div_ [class_ "articles"] ( + mapM_ (article False . preview) featured + ) + +article :: Bool -> Article -> HtmlGenerator () +article raw (Article {body, title, urlPath}) = + article_ (do + header_ (do + aElem [href_ . pack $ "/" urlPath <.> extension] . h1_ $ toHtml title + ) + pre_ . toHtml $ unlines body + ) + where + (aElem, extension) = if raw then (a_, "md") else (navigationA, "html") makeCard :: String -> String -> HtmlGenerator () makeCard title description = do @@ -57,13 +68,6 @@ makeCard title description = do navigationA :: Term arg result => arg -> result navigationA = "a" `termWith` [class_ "navigation"] -previewArticle :: Article -> HtmlGenerator () -previewArticle (Article {urlPath, title, preview}) = - article_ (do - navigationA [href_ . pack $ "/" urlPath <.> "html"] . h3_ $ toHtml title - pre_ $ toHtml preview - ) - tag :: String -> HtmlGenerator () tag tagName = li_ (navigationA [href_ $ pack ("/" tagName)] $ toHtml tagName) @@ -84,8 +88,8 @@ page aPage = head_ (do meta_ [charset_ "utf-8"] title_ . toHtml =<< Blog.get name - script_ [src_ "/UnitJS/async.js"] empty - script_ [src_ "/UnitJS/dom.js"] empty + script_ [src_ "/js/unit.js"] empty + script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/hablo.js"] empty maybe (toHtml empty) faviconLink =<< (Blog.get $skin.$favicon) card aPage diff --git a/src/JSON.hs b/src/JSON.hs index 9d4d30d..a73dd0f 100644 --- a/src/JSON.hs +++ b/src/JSON.hs @@ -7,7 +7,7 @@ module JSON ( import Article (Article) import qualified Article (Article(..)) import Blog (Blog) -import qualified Blog (Blog(..)) +import qualified Blog (Blog(..), Skin(..)) import Control.Monad.Reader (ReaderT, ask) import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode) import Data.ByteString.Lazy (ByteString) @@ -24,16 +24,25 @@ type ArticleID = Int data ArticleExport = ArticleExport { source :: String , title :: String - , date :: EpochTime + , metadata :: Map String String , tagged :: [String] } deriving (Generic) instance ToJSON ArticleExport where toEncoding = genericToEncoding defaultOptions +data SkinExport = SkinExport { + previewArticlesCount :: Int + , previewLinesCount :: Int + } deriving (Generic) + +instance ToJSON SkinExport where + toEncoding = genericToEncoding defaultOptions + data BlogDB = BlogDB { articles :: Map ArticleID ArticleExport , tags :: Map String [ArticleID] + , skin :: SkinExport } deriving (Generic) instance ToJSON BlogDB where @@ -47,7 +56,7 @@ export :: Blog -> FileID -> Article -> ArticleExport export blog fileID article = ArticleExport { source = "/" Article.urlPath article <.> "md" , title = Article.title article - , date = modificationTime $ Article.fileStatus article + , metadata = Article.metadata article , tagged = Map.keys . Map.filter (Set.member fileID) $ Blog.tags blog } @@ -58,4 +67,8 @@ exportBlog = do return . encode $ BlogDB { articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog) , tags = fmap (reindex !) . Set.elems <$> Blog.tags blog + , skin = SkinExport { + previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog + , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog + } }