{-# LANGUAGE OverloadedStrings #-}

module Web.Hablog.Html where

import Data.String (fromString)
import Data.List (sort)
import qualified Data.Text.Lazy as T
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5.Attributes as A


import Web.Hablog.Config
import qualified Web.Hablog.Post as Post
import qualified Web.Hablog.Page as Page

template :: Config -> Bool -> T.Text -> String -> H.Html -> H.Html
template :: Config -> Bool -> Text -> String -> Html -> Html
template cfg :: Config
cfg highlight :: Bool
highlight title :: Text
title pageRoute :: String
pageRoute container :: Html
container =
  Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.title (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ([Text] -> Text
T.concat [Config -> Text
blogTitle Config
cfg, " - ", Text
title]))
      Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.content "width=650" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name "viewport"
      Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel "stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/css" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue)
-> (Theme -> String) -> Theme -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Theme -> String
bgTheme (Theme -> AttributeValue) -> Theme -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Config -> Theme
blogTheme Config
cfg)
      if Bool
highlight
        then Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel "stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/css" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue)
-> (Theme -> String) -> Theme -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Theme -> String
codeTheme (Theme -> AttributeValue) -> Theme -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Config -> Theme
blogTheme Config
cfg)
        else Html
forall a. Monoid a => a
mempty
    Html -> Html
H.body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Config -> String -> Html
logo Config
cfg String
pageRoute
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "maincontainer" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
container
        Html
footer
      if Bool
highlight
        then do
          Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src "/static/highlight/highlight.pack.js" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ""
          Html -> Html
H.script "hljs.initHighlightingOnLoad();"
        else
          Html
forall a. Monoid a => a
mempty

mainTemplate :: H.Html -> H.Html
mainTemplate :: Html -> Html
mainTemplate = Html -> Html
H.article (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "content"

notFoundPage :: Config -> H.Html
notFoundPage :: Config -> Html
notFoundPage cfg :: Config
cfg =
  Config -> Bool -> Text -> String -> Html -> Html
template Config
cfg Bool
False "Not Found" "notfound" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
mainTemplate (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.h1 "Not found"
    Html -> Html
H.p "The page you search for is not available."

logo :: Config -> String -> H.Html
logo :: Config -> String -> Html
logo cfg :: Config
cfg pageRoute :: String
pageRoute = Html -> Html
H.header (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "logo" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.h1 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
  Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pageRoute) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Config -> Text
blogTitle Config
cfg)
  "/" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
pageRoute

footer :: H.Html
footer :: Html
footer = Html -> Html
H.footer (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footer" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href "/blog/rss" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ "RSS feed"
    Html -> Html
H.span "Powered by "
    Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href "https://github.com/soupi/hablog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ "Hablog"

errorPage :: Config -> T.Text -> String -> H.Html
errorPage :: Config -> Text -> String -> Html
errorPage cfg :: Config
cfg ttl :: Text
ttl msg :: String
msg =
  Config -> Bool -> Text -> String -> Html -> Html
template Config
cfg Bool
False Text
ttl "" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.h2 "Something Went Wrong..."
    Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
msg

emptyPage :: H.Html
emptyPage :: Html
emptyPage = Html -> Html
H.span " "


postsListHtml :: [Post.Post] -> H.Html
postsListHtml :: [Post] -> Html
postsListHtml posts :: [Post]
posts =
   Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "PostsList" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.h1 "Posts"
    [Post] -> Html
postsList [Post]
posts

postsList :: [Post.Post] -> H.Html
postsList :: [Post] -> Html
postsList = Html -> Html
H.ul (Html -> Html) -> ([Post] -> Html) -> [Post] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Post] -> [Html]) -> [Post] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post -> Html) -> [Post] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Post -> Html
postsListItem

postsListItem :: Post.Post -> H.Html
postsListItem :: Post -> Html
postsListItem post :: Post
post = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
  Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postDate" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Post -> Text
Post.getDate Post
post
  Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "seperator" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ " - "
  Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ("/blog/" Text -> Text -> Text
`T.append` Post -> Text
Post.getPath Post
post)) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Post -> Text
Post.title Post
post

postPage :: Config -> Post.Post -> H.Html
postPage :: Config -> Post -> Html
postPage cfg :: Config
cfg post :: Post
post = Config -> Bool -> Text -> String -> Html -> Html
template Config
cfg Bool
True (Post -> Text
Post.title Post
post) "blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    Html -> Html
H.article (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "post" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postTitle" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ("/blog/" Text -> Text -> Text
`T.append` Post -> Text
Post.getPath Post
post)) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.h2 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postHeader" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Post -> Text
Post.title Post
post)
        Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postSubTitle" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postAuthor" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Html
authorsList ([Text] -> Html) -> [Text] -> Html
forall a b. (a -> b) -> a -> b
$ Post -> [Text]
Post.authors Post
post
          Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "seperator" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ " - "
          Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postDate" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Post -> Text
Post.getDate Post
post
          Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "seperator" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ " - "
          Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postTags" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Html
tagsList (Post -> [Text]
Post.tags Post
post)
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postContent" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Post -> Html
Post.content Post
post

pagePage :: Config -> Page.Page -> H.Html
pagePage :: Config -> Page -> Html
pagePage cfg :: Config
cfg page :: Page
page = Config -> Bool -> Text -> String -> Html -> Html
template Config
cfg Bool
True (Page -> Text
Page.getPageName Page
page) (Page -> String
Page.getPageURL Page
page) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Page -> Html
pageContent Page
page

pageContent :: Page.Page -> H.Html
pageContent :: Page -> Html
pageContent page :: Page
page = do
  Html -> Html
H.article (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "post" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "postContent" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Page -> Html
Page.getPageContent Page
page

pagesList :: [Page.Page] -> H.Html
pagesList :: [Page] -> Html
pagesList = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Page] -> [Html]) -> [Page] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Page -> Html) -> [Page] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Page -> Html
pagesListItem ([Page] -> [Html]) -> ([Page] -> [Page]) -> [Page] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Page] -> [Page]
forall a. Ord a => [a] -> [a]
sort

pagesListItem :: Page.Page -> H.Html
pagesListItem :: Page -> Html
pagesListItem page :: Page
page =
  Html -> Html
H.li
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString ("/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Page -> String
Page.getPageURL Page
page))
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Page -> Text
Page.getPageName Page
page)

tagsList :: [T.Text] -> H.Html
tagsList :: [Text] -> Html
tagsList = Html -> Html
H.ul (Html -> Html) -> ([Text] -> Html) -> [Text] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Text] -> [Html]) -> [Text] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Html) -> [Text] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
tagsListItem ([Text] -> [Html]) -> ([Text] -> [Text]) -> [Text] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort

tagsListItem :: T.Text -> H.Html
tagsListItem :: Text -> Html
tagsListItem tag :: Text
tag = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ("/blog/tags/" Text -> Text -> Text
`T.append` Text
tag)) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
tag

authorsList :: [T.Text] -> H.Html
authorsList :: [Text] -> Html
authorsList = Html -> Html
H.ul (Html -> Html) -> ([Text] -> Html) -> [Text] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Text] -> [Html]) -> [Text] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Html) -> [Text] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
authorsListItem ([Text] -> [Html]) -> ([Text] -> [Text]) -> [Text] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort

authorsListItem :: T.Text -> H.Html
authorsListItem :: Text -> Html
authorsListItem author :: Text
author = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ("/blog/authors/" Text -> Text -> Text
`T.append` Text
author)) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
author