{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module DOM ( page ) where import Article (Article(..)) import qualified Article (preview) import ArticlesList (ArticlesList(..), otherUrl, description) import Blog (Blog(..), Path(..), Skin(..), URL(..)) import qualified Blog (get) import Blog.Wording (render) import Control.Monad.Reader (ReaderT) import qualified Data.Map as Map (keys) import Data.Text (pack, empty) import DOM.Card (HasCard) import qualified DOM.Card as Card (make) import Files (absoluteLink) import Lucid ( HtmlT, a_, article_, body_, charset_, class_, div_, doctypehtml_, h1_, h2_ , head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_ , title_, toHtml, toHtmlRaw, type_, ul_ ) import Prelude hiding (head, lookup) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) type HtmlGenerator = HtmlT (ReaderT Blog IO) class HasCard a => Page a where content :: a -> HtmlGenerator () instance Page Article where content = article True instance Page ArticlesList where content al@(ArticlesList {featured, full}) = do preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) h2_ . toHtml =<< description al a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink div_ [class_ "articles"] ( mapM_ (article False . preview) featured ) where link = render (if full then "latestLink" else "allLink") [] otherLink = Blog.get $wording.$(link) article :: Bool -> Article -> HtmlGenerator () article raw (Article {key, body, Article.title}) = do url <- absoluteLink . ( key <.> extension) <$> (Blog.get $path.$articlesPath) article_ [id_ $ pack key] (do header_ (do a_ [href_ . pack $ url] . h1_ $ toHtml title ) pre_ . toHtml $ unlines body ) where extension = if raw then "md" else "html" tag :: String -> HtmlGenerator () tag tagName = li_ ( a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName ) defaultBanner :: HtmlGenerator () defaultBanner = do div_ [id_ "header"] ( a_ [href_ "/"] ( h1_ . toHtml =<< Blog.get name ) ) faviconLink :: FilePath -> HtmlGenerator () faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"] optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator () optional = maybe (return ()) page :: Page a => a -> HtmlGenerator () page aPage = doctypehtml_ (do head_ (do meta_ [charset_ "utf-8"] title_ . toHtml =<< Blog.get name script_ [src_ "/js/unit.js"] empty script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/hablo.js"] empty optional faviconLink =<< (Blog.get $skin.$favicon) optional (Card.make aPage) =<< (Blog.get $urls.$cards) (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw ) body_ (do maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner) div_ [id_ "navigator"] (do h2_ =<< (Blog.get $wording.$(render "tagsList" []).$toHtml) ul_ . mapM_ tag . Map.keys =<< Blog.get tags ) div_ [id_ "contents"] $ content aPage ) )