-- | Running Hablog

{-# LANGUAGE OverloadedStrings #-}

module Web.Hablog.Run where

import           Web.Scotty.Trans
import           Web.Scotty.TLS (scottyTTLS)
import           Control.Monad.Trans.Reader (runReaderT)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Text.Blaze.Html.Renderer.Text as HR
import qualified Network.Mime as Mime (defaultMimeLookup)
import Network.URI (URI, parseURI)
import Control.Monad
import Data.Maybe

import Web.Hablog.Types
import Web.Hablog.Config
import Web.Hablog.Present
import Web.Hablog.Html (errorPage)
import Web.Hablog.Post (eqY, eqYM, eqDate)

-- | Run Hablog on HTTP
run :: Config -> Int -> IO ()
run :: Config -> Int -> IO ()
run cfg :: Config
cfg port :: Int
port =
  Int
-> (ReaderT Config IO Response -> IO Response)
-> ScottyT Text (ReaderT Config IO) ()
-> IO ()
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, MonadIO n) =>
Int -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyT Int
port (ReaderT Config IO Response -> Config -> IO Response
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Config
cfg) (Maybe URI -> ScottyT Text (ReaderT Config IO) ()
router (Maybe URI -> ScottyT Text (ReaderT Config IO) ())
-> Maybe URI -> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$! Maybe URI
domain)
  where
    domain :: Maybe URI
domain = String -> Maybe URI
parseURI (Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Config -> Text
blogDomain Config
cfg)

-- | Run Hablog on HTTPS
runTLS :: TLSConfig -> Config -> IO ()
runTLS :: TLSConfig -> Config -> IO ()
runTLS tlsCfg :: TLSConfig
tlsCfg cfg :: Config
cfg =
  Int
-> String
-> String
-> (ReaderT Config IO Response -> IO Response)
-> ScottyT Text (ReaderT Config IO) ()
-> IO ()
forall (m :: * -> *) (n :: * -> *) t.
(Monad m, MonadIO n) =>
Int
-> String
-> String
-> (m Response -> IO Response)
-> ScottyT t m ()
-> n ()
scottyTTLS (TLSConfig -> Int
blogTLSPort TLSConfig
tlsCfg) (TLSConfig -> String
blogKey TLSConfig
tlsCfg) (TLSConfig -> String
blogCert TLSConfig
tlsCfg) (ReaderT Config IO Response -> Config -> IO Response
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Config
cfg) (Maybe URI -> ScottyT Text (ReaderT Config IO) ()
router (Maybe URI -> ScottyT Text (ReaderT Config IO) ())
-> Maybe URI -> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$! Maybe URI
domain)
  where
    domain :: Maybe URI
domain = String -> Maybe URI
parseURI (Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Config -> Text
blogDomain Config
cfg)

-- | Hablog's router
router :: Maybe URI -> Hablog ()
router :: Maybe URI -> ScottyT Text (ReaderT Config IO) ()
router domain :: Maybe URI
domain = do
  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get ("/favicon.ico") (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    let
      path :: String
path = "static/favicon.ico"
      mime :: MimeType
mime = FileName -> MimeType
Mime.defaultMimeLookup (String -> FileName
T.pack String
path)
    Text -> Text -> ActionT Text (ReaderT Config IO) ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
setHeader "content-type" (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ FileName -> Text
TL.fromStrict (MimeType -> FileName
T.decodeUtf8 MimeType
mime)
    String -> ActionT Text (ReaderT Config IO) ()
forall (m :: * -> *) e. Monad m => String -> ActionT e m ()
file String
path

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get (String -> RoutePattern
regex "/static/(.*)") (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    String
path <- (FileName -> String)
-> ActionT Text (ReaderT Config IO) FileName
-> ActionT Text (ReaderT Config IO) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> (FileName -> String) -> FileName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> String
T.unpack) (Text -> ActionT Text (ReaderT Config IO) FileName
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "0")
    if String -> Bool
hasdots String
path then
      String -> ActionT Text (ReaderT Config IO) ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "no dots in path allowed"
      else do
        let mime :: MimeType
mime = FileName -> MimeType
Mime.defaultMimeLookup (String -> FileName
T.pack String
path)
        Text -> Text -> ActionT Text (ReaderT Config IO) ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
setHeader "content-type" (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ FileName -> Text
TL.fromStrict (MimeType -> FileName
T.decodeUtf8 MimeType
mime)
        String -> ActionT Text (ReaderT Config IO) ()
forall (m :: * -> *) e. Monad m => String -> ActionT e m ()
file String
path

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/" ActionT Text (ReaderT Config IO) ()
presentHome

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog" ActionT Text (ReaderT Config IO) ()
presentBlog

  Maybe URI -> ScottyT Text (ReaderT Config IO) ()
route Maybe URI
domain

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/:page" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
page <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "page"
    Text -> ActionT Text (ReaderT Config IO) ()
presentPage (Text -> Text
TL.toLower Text
page)

  ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m () -> ScottyT e m ()
notFound (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Config
cfg <- HablogAction Config
getCfg
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ Html -> Text
HR.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Text -> String -> Html
errorPage Config
cfg (Config -> Text
blogTitle Config
cfg Text -> Text -> Text
`TL.append` " - 404: not found") "404 - Could not find the page you were looking for."

  where
    hasdots :: String -> Bool
hasdots [] = Bool
False
    hasdots ('.':'.':_) = Bool
True
    hasdots (_:rest :: String
rest) = String -> Bool
hasdots String
rest


route :: Maybe URI -> Hablog ()
route :: Maybe URI -> ScottyT Text (ReaderT Config IO) ()
route domain :: Maybe URI
domain = do
  Bool
-> ScottyT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe URI -> Bool
forall a. Maybe a -> Bool
isJust Maybe URI
domain)
    (ScottyT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ScottyT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/rss" (URI -> ActionT Text (ReaderT Config IO) ()
presentRSS (URI -> ActionT Text (ReaderT Config IO) ())
-> URI -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust Maybe URI
domain)

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/post/:yyyy/:mm/:dd/:title" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    (yyyy :: Text
yyyy, mm :: Text
mm, dd :: Text
dd) <- ActionT Text (ReaderT Config IO) (Text, Text, Text)
getDate
    Text
title <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "title"
    Text -> ActionT Text (ReaderT Config IO) ()
presentPost ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
yyyy,"/",Text
mm,"/",Text
dd, "/", Text
title])

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/post/:yyyy/:mm/:dd" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    (yyyy :: Text
yyyy, mm :: Text
mm, dd :: Text
dd) <- ActionT Text (ReaderT Config IO) (Text, Text, Text)
getDate
    (Post -> Bool) -> ActionT Text (ReaderT Config IO) ()
showPostsWhere ((Text, Text, Text) -> Post -> Bool
eqDate (Text
yyyy, Text
mm, Text
dd))

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/post/:yyyy/:mm" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
yyyy <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "yyyy"
    Text
mm <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "mm"
    (Post -> Bool) -> ActionT Text (ReaderT Config IO) ()
showPostsWhere ((Text, Text) -> Post -> Bool
eqYM (Text
yyyy, Text
mm))

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/post/:yyyy" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
yyyy <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "yyyy"
    (Post -> Bool) -> ActionT Text (ReaderT Config IO) ()
showPostsWhere (Text -> Post -> Bool
eqY Text
yyyy)

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/tags"
    ActionT Text (ReaderT Config IO) ()
presentTags

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/tags/:tag" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
tag <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "tag"
    Text -> ActionT Text (ReaderT Config IO) ()
presentTag Text
tag

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/authors"
    ActionT Text (ReaderT Config IO) ()
presentAuthors

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/blog/authors/:author" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
author <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "author"
    Text -> ActionT Text (ReaderT Config IO) ()
presentAuthor Text
author

  -- redirects

  Bool
-> ScottyT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe URI -> Bool
forall a. Maybe a -> Bool
isJust Maybe URI
domain)
    (ScottyT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ScottyT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/rss" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect "/blog/rss"

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/post/:yyyy/:mm/:dd/:title" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    (yyyy :: Text
yyyy, mm :: Text
mm, dd :: Text
dd) <- ActionT Text (ReaderT Config IO) (Text, Text, Text)
getDate
    Text
title <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "title"
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/post/", Text
yyyy, "/", Text
mm, "/", Text
dd, "/", Text
title]

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/post/:yyyy/:mm/:dd" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    (yyyy :: Text
yyyy, mm :: Text
mm, dd :: Text
dd) <- ActionT Text (ReaderT Config IO) (Text, Text, Text)
getDate
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/post/", Text
yyyy, "/", Text
mm, "/", Text
dd]

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/post/:yyyy/:mm" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
yyyy <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "yyyy"
    Text
mm <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "mm"
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/post/", Text
yyyy, "/", Text
mm]

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/post/:yyyy" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
yyyy <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "yyyy"
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/post/", Text
yyyy]

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/tags" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect "/blog/tags"

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/tags/:tag" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
tag <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "tag"
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/tags/", Text
tag]

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/authors" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect "/blog/authors"

  RoutePattern
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
get "/authors/:author" (ActionT Text (ReaderT Config IO) ()
 -> ScottyT Text (ReaderT Config IO) ())
-> ActionT Text (ReaderT Config IO) ()
-> ScottyT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ do
    Text
author <- Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "author"
    Text -> ActionT Text (ReaderT Config IO) ()
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
Text -> ActionT e m a
redirect (Text -> ActionT Text (ReaderT Config IO) ())
-> Text -> ActionT Text (ReaderT Config IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["/blog/authors/", Text
author]

  where
    getDate :: ActionT Text (ReaderT Config IO) (Text, Text, Text)
getDate =  (,,)
           (Text -> Text -> Text -> (Text, Text, Text))
-> ActionT Text (ReaderT Config IO) Text
-> ActionT
     Text (ReaderT Config IO) (Text -> Text -> (Text, Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "yyyy"
           ActionT
  Text (ReaderT Config IO) (Text -> Text -> (Text, Text, Text))
-> ActionT Text (ReaderT Config IO) Text
-> ActionT Text (ReaderT Config IO) (Text -> (Text, Text, Text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "mm"
           ActionT Text (ReaderT Config IO) (Text -> (Text, Text, Text))
-> ActionT Text (ReaderT Config IO) Text
-> ActionT Text (ReaderT Config IO) (Text, Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ActionT Text (ReaderT Config IO) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
param "dd"