Tissevert
/
hablo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement JS navigation

This commit is contained in:
Tissevert 2019-02-15 14:13:43 +01:00
parent 515fb14914
commit d1d874d597
8 changed files with 291 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
hablo.cabal
View File

@ -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

78
js/domRenderer.js Normal file
View File

@ -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))
];
};
}
}

11
js/main.js
View File

@ -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();
});

106
js/navigation.js Normal file
View File

@ -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);
})
)
);
}
}

86
src/Article.hs
View File

@ -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}

11
src/Blog.hs
View File

@ -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 {

34
src/Dom.hs
View File

@ -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

19
src/JSON.hs
View File

@ -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
}
}