{-# 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 :: 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)
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)
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
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"