{-# LANGUAGE OverloadedStrings #-}

module Web.Hablog.Present where

import           Web.Scotty.Trans
import           Control.Monad.IO.Class (liftIO)
import           Data.Maybe (catMaybes)
import           Data.Either (rights)
import qualified Data.List as L
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSLC

import qualified Text.Blaze.Html.Renderer.Text as HR
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import           Text.Blaze.Html5 ((!))

import qualified System.Directory as DIR (getDirectoryContents)
import           System.IO.Error (catchIOError)
import qualified Text.RSS as RSS

import Web.Hablog.Html
import Web.Hablog.Types
import Web.Hablog.Config
import qualified Web.Hablog.Post as Post
import qualified Web.Hablog.Page  as Page
import Network.URI (URI)


presentHome :: HablogAction ()
presentHome :: HablogAction ()
presentHome = do
  [Page]
allPages <- IO [Page] -> ActionT Text (ReaderT Config IO) [Page]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Page]
getAllPages
  Config
cfg <- HablogAction Config
getCfg
  case (Page -> Bool) -> [Page] -> Maybe Page
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\p :: Page
p -> Page -> FilePath
Page.getPageURL Page
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "home") [Page]
allPages of
    Nothing -> HablogAction ()
presentBlog
    Just homePage :: Page
homePage -> do
      Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ()) -> Text -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False "home" "home" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "pages" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            [Page] -> Html
pagesList [Page]
allPages
            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 "/blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ "Blog"
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "content" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
          Page -> Html
pageContent Page
homePage


presentBlog :: HablogAction ()
presentBlog :: HablogAction ()
presentBlog = do
  [Post]
allPosts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  [Page]
allPages <- IO [Page] -> ActionT Text (ReaderT Config IO) [Page]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Page]
getAllPages
  Html
tgs <- IO Html -> ActionT Text (ReaderT Config IO) Html
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Html
getTagList
  Html
auths <- IO Html -> ActionT Text (ReaderT Config IO) Html
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Html
getAuthorsList
  Config
cfg <- HablogAction Config
getCfg
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ()) -> Text -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False "Blog" "blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "pages" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        [Page] -> Html
pagesList [Page]
allPages
        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 "/blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ "Blog"
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "main-content" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      [Post] -> Html
postsListHtml [Post]
allPosts
      Html -> Html
H.aside (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "aside" (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_ "AllAuthorsList" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.h1 "Authors"
          Html
auths
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "AllTagsList" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.h1 "Tags"
          Html
tgs

presentRSS :: URI -> HablogAction ()
presentRSS :: URI -> HablogAction ()
presentRSS domain :: URI
domain = do
  Config
cfg <- HablogAction Config
getCfg
  [Post]
allPosts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  let mime :: Text
mime = "application/rss+xml"
  Text -> Text -> HablogAction ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
setHeader "content-type" Text
mime
  ByteString -> HablogAction ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw
    (ByteString -> HablogAction ())
-> ([Post] -> ByteString) -> [Post] -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BSLC.pack
    (FilePath -> ByteString)
-> ([Post] -> FilePath) -> [Post] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFilter () -> FilePath
RSS.showXML
    (CFilter () -> FilePath)
-> ([Post] -> CFilter ()) -> [Post] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSS -> CFilter ()
RSS.rssToXML
    (RSS -> CFilter ()) -> ([Post] -> RSS) -> [Post] -> CFilter ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> URI -> FilePath -> [ChannelElem] -> [Item] -> RSS
RSS.RSS (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Config -> Text
blogTitle Config
cfg) URI
domain "" []
    ([Item] -> RSS) -> ([Post] -> [Item]) -> [Post] -> RSS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post -> Item) -> [Post] -> [Item]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Post -> Item
Post.toRSS (Text -> Post -> Item) -> Text -> Post -> Item
forall a b. (a -> b) -> a -> b
$ Config -> Text
blogDomain Config
cfg)
    ([Post] -> HablogAction ()) -> [Post] -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ [Post]
allPosts

showPostsWhere :: (Post.Post -> Bool) -> HablogAction ()
showPostsWhere :: (Post -> Bool) -> HablogAction ()
showPostsWhere test :: Post -> Bool
test = do
  Config
cfg <- HablogAction Config
getCfg
  [Post]
allPosts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ()) -> Text -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False "Posts" "blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    [Post] -> Html
postsListHtml ([Post] -> Html) -> [Post] -> Html
forall a b. (a -> b) -> a -> b
$ (Post -> Bool) -> [Post] -> [Post]
forall a. (a -> Bool) -> [a] -> [a]
filter Post -> Bool
test [Post]
allPosts

presentPage :: T.Text -> HablogAction ()
presentPage :: Text -> HablogAction ()
presentPage route :: Text
route = do
  [Page]
pages <- IO [Page] -> ActionT Text (ReaderT Config IO) [Page]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Page]
getAllPages
  (Config -> Page -> Html) -> [Page] -> HablogAction ()
forall a. (Config -> a -> Html) -> [a] -> HablogAction ()
showOrNotFound ([Page] -> Config -> Page -> Html
presentPage' [Page]
pages) ([Page] -> HablogAction ())
-> ([Page] -> [Page]) -> [Page] -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Page -> Bool) -> [Page] -> [Page]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
route) (FilePath -> Bool) -> (Page -> FilePath) -> Page -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Page -> FilePath
Page.getPageURL) ([Page] -> HablogAction ()) -> [Page] -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ [Page]
pages

presentPage' :: [Page.Page] -> Config -> Page.Page -> H.Html
presentPage' :: [Page] -> Config -> Page -> Html
presentPage' pages :: [Page]
pages cfg :: Config
cfg page :: Page
page = do
  Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False (Page -> Text
Page.getPageName Page
page) (Page -> FilePath
Page.getPageURL Page
page) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "pages" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        [Page] -> Html
pagesList [Page]
pages
        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 "/blog" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ "Blog"
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "content" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Page -> Html
pageContent Page
page



getAllPages :: IO [Page.Page]
getAllPages :: IO [Page]
getAllPages = (Text -> Maybe Page) -> FilePath -> IO [Page]
forall a. Ord a => (Text -> Maybe a) -> FilePath -> IO [a]
getAllFromDir Text -> Maybe Page
Page.toPage "_pages"

getAllPosts :: IO [Post.Post]
getAllPosts :: IO [Post]
getAllPosts = (Text -> Maybe Post) -> FilePath -> IO [Post]
forall a. Ord a => (Text -> Maybe a) -> FilePath -> IO [a]
getAllFromDir Text -> Maybe Post
Post.toPost "_posts"

getAllFromDir :: Ord a => (T.Text -> Maybe a) -> FilePath -> IO [a]
getAllFromDir :: (Text -> Maybe a) -> FilePath -> IO [a]
getAllFromDir parse :: Text -> Maybe a
parse dir :: FilePath
dir = do
  [FilePath]
posts <- ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete ".." ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete ".") (FilePath -> IO [FilePath]
DIR.getDirectoryContents FilePath
dir IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []))
  [Text]
contents <- [Either UnicodeException Text] -> [Text]
forall a b. [Either a b] -> [b]
rights ([Either UnicodeException Text] -> [Text])
-> IO [Either UnicodeException Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Either UnicodeException Text))
-> [FilePath] -> IO [Either UnicodeException Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((\x :: FilePath
x -> (ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> IO ByteString -> IO (Either UnicodeException Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BSL.readFile FilePath
x) IO (Either UnicodeException Text)
-> (IOError -> IO (Either UnicodeException Text))
-> IO (Either UnicodeException Text)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` IO (Either UnicodeException Text)
-> IOError -> IO (Either UnicodeException Text)
forall a b. a -> b -> a
const (Either UnicodeException Text -> IO (Either UnicodeException Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> IO (Either UnicodeException Text))
-> Either UnicodeException Text
-> IO (Either UnicodeException Text)
forall a b. (a -> b) -> a -> b
$ UnicodeException -> Either UnicodeException Text
forall a b. a -> Either a b
Left UnicodeException
forall a. HasCallStack => a
undefined)) (FilePath -> IO (Either UnicodeException Text))
-> (FilePath -> FilePath)
-> FilePath
-> IO (Either UnicodeException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
dirFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++"/")FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)) [FilePath]
posts
  [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> IO [a]) -> ([Maybe a] -> [a]) -> [Maybe a] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([a] -> [a]) -> ([Maybe a] -> [a]) -> [Maybe a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> IO [a]) -> [Maybe a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe a) -> [Text] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe a
parse ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
contents)

presentPost :: T.Text -> HablogAction ()
presentPost :: Text -> HablogAction ()
presentPost title :: Text
title = do
  [Post]
posts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  (Config -> Post -> Html) -> [Post] -> HablogAction ()
forall a. (Config -> a -> Html) -> [a] -> HablogAction ()
showOrNotFound Config -> Post -> Html
postPage ([Post] -> HablogAction ()) -> [Post] -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ (Post -> Bool) -> [Post] -> [Post]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
title) (Text -> Bool) -> (Post -> Text) -> Post -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> Text
path) [Post]
posts
  where path :: Post -> Text
path p :: Post
p = Text -> [Text] -> Text
T.intercalate "/" ([Post -> Text
Post.year, Post -> Text
Post.month, Post -> Text
Post.day, Post -> Text
Post.route] [Post -> Text] -> [Post] -> [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Post
p])

showOrNotFound :: (Config -> a -> H.Html) -> [a] -> HablogAction ()
showOrNotFound :: (Config -> a -> Html) -> [a] -> HablogAction ()
showOrNotFound showP :: Config -> a -> Html
showP result :: [a]
result = do
  Config
cfg <- HablogAction Config
getCfg
  case [a]
result of
    (p :: a
p:_) -> Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ()) -> Text -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> a -> Html
showP Config
cfg a
p
    []    -> Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ()) -> Text -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Text -> FilePath -> Html
errorPage Config
cfg "Hablog - 404: not found" "Could not find the page you were looking for."

presentTags :: HablogAction ()
presentTags :: HablogAction ()
presentTags = do
  Config
cfg <- HablogAction Config
getCfg
  Html
tags <- IO Html -> ActionT Text (ReaderT Config IO) Html
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Html
getTagList
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ())
-> (Html -> Text) -> Html -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
HR.renderHtml (Html -> HablogAction ()) -> Html -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False "Posts Tags" "blog" Html
tags

getTagList :: IO H.Html
getTagList :: IO Html
getTagList = Html -> IO Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> IO Html) -> ([Post] -> Html) -> [Post] -> IO Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Html
tagsList ([Text] -> Html) -> ([Post] -> [Text]) -> [Post] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Post] -> [Text]
getAllTags ([Post] -> IO Html) -> IO [Post] -> IO Html
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Post]
getAllPosts

getPageList :: [Page.Page] -> H.Html
getPageList :: [Page] -> Html
getPageList = Html -> Html
H.ul (Html -> Html) -> ([Page] -> Html) -> [Page] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Page] -> Html
pagesList


getAuthorsList :: IO H.Html
getAuthorsList :: IO Html
getAuthorsList = Html -> IO Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> IO Html) -> ([Post] -> Html) -> [Post] -> IO Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Html
authorsList ([Text] -> Html) -> ([Post] -> [Text]) -> [Post] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Post] -> [Text]
getAllAuthors ([Post] -> IO Html) -> IO [Post] -> IO Html
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Post]
getAllPosts

presentTag :: T.Text -> HablogAction ()
presentTag :: Text -> HablogAction ()
presentTag tag :: Text
tag = do
  Config
cfg <- HablogAction Config
getCfg
  [Post]
posts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ())
-> (Html -> Text) -> Html -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
HR.renderHtml (Html -> Text) -> (Html -> Html) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False Text
tag "blog" (Html -> HablogAction ()) -> Html -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ [Post] -> Html
postsListHtml ([Post] -> Html) -> [Post] -> Html
forall a b. (a -> b) -> a -> b
$ (Post -> Bool) -> [Post] -> [Post]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Post -> Bool
hasTag Text
tag) [Post]
posts

presentAuthors :: HablogAction ()
presentAuthors :: HablogAction ()
presentAuthors = do
  Config
cfg <- HablogAction Config
getCfg
  Html
authors <- IO Html -> ActionT Text (ReaderT Config IO) Html
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Html
getAuthorsList
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ())
-> (Html -> Text) -> Html -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
HR.renderHtml (Html -> HablogAction ()) -> Html -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False "Posts Authors" "blog" Html
authors

presentAuthor :: T.Text -> HablogAction ()
presentAuthor :: Text -> HablogAction ()
presentAuthor auth :: Text
auth = do
  Config
cfg <- HablogAction Config
getCfg
  [Post]
posts <- IO [Post] -> ActionT Text (ReaderT Config IO) [Post]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Post]
getAllPosts
  Text -> HablogAction ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> HablogAction ())
-> ([Post] -> Text) -> [Post] -> HablogAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
HR.renderHtml (Html -> Text) -> ([Post] -> Html) -> [Post] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool -> Text -> FilePath -> Html -> Html
template Config
cfg Bool
False Text
auth "blog" (Html -> Html) -> ([Post] -> Html) -> [Post] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Post] -> Html
postsListHtml ([Post] -> HablogAction ()) -> [Post] -> HablogAction ()
forall a b. (a -> b) -> a -> b
$ (Post -> Bool) -> [Post] -> [Post]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Post -> Bool
hasAuthor Text
auth) [Post]
posts

getPageFromFile :: T.Text -> IO (Maybe Page.Page)
getPageFromFile :: Text -> IO (Maybe Page)
getPageFromFile title :: Text
title = do
  let path :: FilePath
path = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["_pages/", Text
title]
  (Text -> Maybe Page) -> FilePath -> IO (Maybe Page)
forall a. (Text -> Maybe a) -> FilePath -> IO (Maybe a)
getFromFile Text -> Maybe Page
Page.toPage FilePath
path

getPostFromFile :: T.Text -> T.Text -> IO (Maybe Post.Post)
getPostFromFile :: Text -> Text -> IO (Maybe Post)
getPostFromFile date :: Text
date title :: Text
title = do
  let postPath :: FilePath
postPath = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["_posts/", Text
date, "-", Text
title, ".md"]
  (Text -> Maybe Post) -> FilePath -> IO (Maybe Post)
forall a. (Text -> Maybe a) -> FilePath -> IO (Maybe a)
getFromFile Text -> Maybe Post
Post.toPost FilePath
postPath

getFromFile :: (T.Text -> Maybe a) -> String -> IO (Maybe a)
getFromFile :: (Text -> Maybe a) -> FilePath -> IO (Maybe a)
getFromFile constructor :: Text -> Maybe a
constructor path :: FilePath
path = do
  Either UnicodeException Text
fileContent <- (ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> IO ByteString -> IO (Either UnicodeException Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BSL.readFile FilePath
path) IO (Either UnicodeException Text)
-> (IOError -> IO (Either UnicodeException Text))
-> IO (Either UnicodeException Text)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` IO (Either UnicodeException Text)
-> IOError -> IO (Either UnicodeException Text)
forall a b. a -> b -> a
const (Either UnicodeException Text -> IO (Either UnicodeException Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> IO (Either UnicodeException Text))
-> Either UnicodeException Text
-> IO (Either UnicodeException Text)
forall a b. (a -> b) -> a -> b
$ UnicodeException -> Either UnicodeException Text
forall a b. a -> Either a b
Left UnicodeException
forall a. HasCallStack => a
undefined)
  let cont :: Maybe Text
cont = case Either UnicodeException Text
fileContent of
              Left _  -> Maybe Text
forall a. Maybe a
Nothing
              Right x :: Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
  let content :: Maybe a
content = Text -> Maybe a
constructor (Text -> Maybe a) -> Maybe Text -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
cont
  Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
content

getAllTags :: [Post.Post] -> [T.Text]
getAllTags :: [Post] -> [Text]
getAllTags = (Post -> [Text]) -> [Post] -> [Text]
getAll Post -> [Text]
Post.tags

hasTag :: T.Text -> Post.Post -> Bool
hasTag :: Text -> Post -> Bool
hasTag tag :: Text
tag = ([][Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([Text] -> Bool) -> (Post -> [Text]) -> Post -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
tag) ([Text] -> [Text]) -> (Post -> [Text]) -> Post -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> [Text]
Post.tags

getAllAuthors :: [Post.Post] -> [T.Text]
getAllAuthors :: [Post] -> [Text]
getAllAuthors = (Post -> [Text]) -> [Post] -> [Text]
getAll Post -> [Text]
Post.authors

getAll :: (Post.Post -> [T.Text]) -> [Post.Post] -> [T.Text]
getAll :: (Post -> [Text]) -> [Post] -> [Text]
getAll f :: Post -> [Text]
f  = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> ([Post] -> [Text]) -> [Post] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head) ([[Text]] -> [Text]) -> ([Post] -> [[Text]]) -> [Post] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
L.group ([Text] -> [[Text]]) -> ([Post] -> [Text]) -> [Post] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> ([Post] -> [Text]) -> [Post] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post -> [Text]) -> [Post] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Post -> [Text]
f

hasAuthor :: T.Text -> Post.Post -> Bool
hasAuthor :: Text -> Post -> Bool
hasAuthor auth :: Text
auth myPost :: Post
myPost = Text
auth Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Post -> [Text]
Post.authors Post
myPost