summary refs log tree commit diff
path: root/services/tazblog/src/Server.hs
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@google.com>2019-08-25T19·15+0100
committerVincent Ambo <tazjin@google.com>2019-08-25T19·15+0100
commit1747df418e8cdd5d9de1a643354d7ac28591ed14 (patch)
treed2d2ff27374bd40f5c3bcdf366343b1b76297a1c /services/tazblog/src/Server.hs
parent2fdc87222871e6b68ba2d7ee1c634cfa0d75c572 (diff)
chore(tazblog): Format source files with ormolu r/60
Ormolu's formatting is quite annoying (it uses a lot of unnecessary
vertical space and doesn't align elements), but I can't be bothered to
do manual formatting - especially because whatever formatting
haskell-mode in Emacs produces seems to depend on an opaque state
machine or something.
Diffstat (limited to 'services/tazblog/src/Server.hs')
-rw-r--r--services/tazblog/src/Server.hs75
1 files changed, 40 insertions, 35 deletions
diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs
index 8a7384ccca3e..492849a2f39d 100644
--- a/services/tazblog/src/Server.hs
+++ b/services/tazblog/src/Server.hs
@@ -1,16 +1,19 @@
-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, OverloadedStrings, FlexibleContexts #-}
-module Server where
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-import           Control.Applicative    (optional)
-import Control.Monad (msum)
-import           Control.Monad.IO.Class (liftIO)
-import           Data.Char              (toLower)
-import qualified Data.Text              as T
-import           Happstack.Server       hiding (Session)
-import Data.Maybe (maybe)
+module Server where
 
 import Blog
 import BlogStore
+import Control.Applicative (optional)
+import Control.Monad (msum)
+import Control.Monad.IO.Class (liftIO)
+import Data.Char (toLower)
+import Data.Maybe (maybe)
+import qualified Data.Text as T
+import Happstack.Server hiding (Session)
 import Locales
 import RSS
 
@@ -19,7 +22,7 @@ instance FromReqURI BlogLang where
     case map toLower sub of
       "de" -> Just DE
       "en" -> Just EN
-      _    -> Nothing
+      _ -> Nothing
 
 pageSize :: Int
 pageSize = 3
@@ -34,21 +37,23 @@ runBlog port respath = do
 
 tazBlog :: BlogCache -> String -> ServerPart Response
 tazBlog cache resDir = do
-    msum [ path $ \(lang :: BlogLang) -> blogHandler cache lang
-         , dir "static" $ staticHandler resDir
-         , blogHandler cache EN
-         , staticHandler resDir
-         , notFound $ toResponse $ showError NotFound DE
-         ]
+  msum
+    [ path $ \(lang :: BlogLang) -> blogHandler cache lang,
+      dir "static" $ staticHandler resDir,
+      blogHandler cache EN,
+      staticHandler resDir,
+      notFound $ toResponse $ showError NotFound DE
+      ]
 
 blogHandler :: BlogCache -> BlogLang -> ServerPart Response
 blogHandler cache lang =
-    msum [ path $ \(eId :: Integer) -> showEntry cache lang $ EntryId eId
-         , nullDir >> showIndex cache lang
-         , dir "rss" $ nullDir >> showRSS cache lang
-         , dir "rss.xml" $ nullDir >> showRSS cache lang
-         , notFound $ toResponse $ showError NotFound lang
-         ]
+  msum
+    [ path $ \(eId :: Integer) -> showEntry cache lang $ EntryId eId,
+      nullDir >> showIndex cache lang,
+      dir "rss" $ nullDir >> showRSS cache lang,
+      dir "rss.xml" $ nullDir >> showRSS cache lang,
+      notFound $ toResponse $ showError NotFound lang
+      ]
 
 staticHandler :: String -> ServerPart Response
 staticHandler resDir = do
@@ -58,29 +63,29 @@ staticHandler resDir = do
 
 showEntry :: BlogCache -> BlogLang -> EntryId -> ServerPart Response
 showEntry cache lang eId = do
-    entry <- getEntry cache eId
-    tryEntry entry lang
+  entry <- getEntry cache eId
+  tryEntry entry lang
 
 tryEntry :: Maybe Entry -> BlogLang -> ServerPart Response
 tryEntry Nothing lang = notFound $ toResponse $ showError NotFound lang
 tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEntry entry
-    where
-        eTitle = T.append ": " (title entry)
-        eLang = lang entry
+  where
+    eTitle = T.append ": " (title entry)
+    eLang = lang entry
 
 offset :: Maybe Int -> Int
 offset = maybe 0 ((*) pageSize)
 
 showIndex :: BlogCache -> BlogLang -> ServerPart Response
 showIndex cache lang = do
-    (page :: Maybe Int) <- optional $ lookRead "page"
-    entries <- listEntries cache (offset page) pageSize
-    ok $ toResponse $ blogTemplate lang "" $
-        renderEntries entries (Just $ showLinks page lang)
+  (page :: Maybe Int) <- optional $ lookRead "page"
+  entries <- listEntries cache (offset page) pageSize
+  ok $ toResponse $ blogTemplate lang ""
+    $ renderEntries entries (Just $ showLinks page lang)
 
 showRSS :: BlogCache -> BlogLang -> ServerPart Response
 showRSS cache lang = do
-    entries <- listEntries cache 0 4
-    feed <- liftIO $ renderFeed lang entries
-    setHeaderM "content-type" "text/xml"
-    ok $ toResponse feed
+  entries <- listEntries cache 0 4
+  feed <- liftIO $ renderFeed lang entries
+  setHeaderM "content-type" "text/xml"
+  ok $ toResponse feed