From 58d2f3c1c2d41aa52a33bacd8159277cd3c86b86 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Thu, 7 May 2020 17:09:21 +0200
Subject: [PATCH] Get rid of useless Blog.get that was actually a
 re-implementation of MonadReader's 'asks'

---
 src/Blog.hs     |  4 ----
 src/DOM.hs      | 19 +++++++++----------
 src/DOM/Card.hs |  8 ++++----
 src/JS.hs       |  7 +++----
 4 files changed, 16 insertions(+), 22 deletions(-)

diff --git a/src/Blog.hs b/src/Blog.hs
index 1fa5789..188e983 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -9,7 +9,6 @@ module Blog (
     , URL(..)
     , Wording
     , build
-    , get
     , template
   ) where
 
@@ -61,9 +60,6 @@ type Renderer m = (MonadIO m, MonadReader Blog m)
 template :: Renderer m => String -> Environment -> m Text
 template key environment = asks templates >>= render key environment
 
-get :: MonadReader Blog m => (Blog -> a) -> m a
-get = asks
-
 keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article)
 keepOrWarn accumulator (Left parseErrors) =
   forM [show parseErrors, "=> Ignoring this article"] putStrLn
diff --git a/src/DOM.hs b/src/DOM.hs
index 015c2a7..91912ed 100644
--- a/src/DOM.hs
+++ b/src/DOM.hs
@@ -10,7 +10,6 @@ import ArticlesList (
     ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
   )
 import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
-import qualified Blog (get)
 import Control.Monad.Reader (ReaderT, asks)
 import qualified Data.Map as Map (keys)
 import Data.Text (pack, empty)
@@ -36,7 +35,7 @@ instance Page Article where
 
 instance Page ArticlesList where
   content al@(ArticlesList {full}) = do
-    preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
+    preview <- Article.preview <$> (asks $skin.$previewLinesCount)
     h2_ . toHtml =<< description al
     ul_ $ do
       asks hasRSS >>= rssLink
@@ -55,7 +54,7 @@ instance Page ArticlesList where
 
 article :: Bool -> Article -> HtmlGenerator ()
 article raw (Article {key, body, Article.title}) = do
-  url <- absoluteLink . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
+  url <- absoluteLink . (</> key <.> extension) <$> (asks $path.$articlesPath)
   article_ [id_ $ pack key] (do
       header_ (do
           a_ [href_ $ pack url] . h1_ $ toHtml title
@@ -73,7 +72,7 @@ defaultBanner :: HtmlGenerator ()
 defaultBanner = do
   div_ [id_ "header"] (
       a_ [href_ "/"] (
-          h1_ . toHtml =<< Blog.get name
+          h1_ . toHtml =<< asks name
         )
     )
 
@@ -88,19 +87,19 @@ page aPage =
   doctypehtml_ (do
       head_ (do
           meta_ [charset_ "utf-8"]
-          title_ . toHtml =<< Blog.get name
+          title_ . toHtml =<< asks name
           script_ [src_ "/js/unit.js"] empty
           script_ [src_ "/js/remarkable.min.js"] empty
           script_ [src_ "/js/hablo.js"] empty
-          optional faviconLink =<< (Blog.get $skin.$favicon)
-          optional (Card.make aPage) =<< (Blog.get $urls.$cards)
-          (Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
+          optional faviconLink =<< (asks $skin.$favicon)
+          optional (Card.make aPage) =<< (asks $urls.$cards)
+          (asks $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
         )
       body_ (do
-          maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner)
+          maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
           div_ [id_ "navigator"] (do
               h2_ . toHtml =<< template "tagsList" []
-              ul_ . mapM_ tag . Map.keys =<< Blog.get tags
+              ul_ . mapM_ tag . Map.keys =<< asks tags
             )
           div_ [id_ "contents"] $ content aPage
         )
diff --git a/src/DOM/Card.hs b/src/DOM/Card.hs
index 9b69131..55334cc 100644
--- a/src/DOM/Card.hs
+++ b/src/DOM/Card.hs
@@ -11,10 +11,10 @@ import qualified Article (Article(..))
 import ArticlesList (ArticlesList(..))
 import qualified ArticlesList (description)
 import Blog (Blog(..), Renderer, Skin(..))
-import qualified Blog (get)
 import Collection (Collection(..))
 import qualified Collection (title)
 import Control.Applicative ((<|>))
+import Control.Monad.Reader (asks)
 import qualified Data.Map as Map (lookup)
 import Data.Text (Text, pack)
 import Lucid (HtmlT, content_, meta_)
@@ -46,8 +46,8 @@ make element siteURL = do
   og "type" cardType
   og "title" $ pack title
   og "description" description
-  maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage))
-  og "site_name" =<< (Blog.get $name.$pack)
+  maybeImage =<< ((image <|>) <$> (asks $skin.$cardImage))
+  og "site_name" =<< (asks $name.$pack)
   where
     maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))
 
@@ -62,7 +62,7 @@ instance HasCard Article.Article where
         , urlPath = "/articles/" ++ title ++ ".html"
       }
     where
-      getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
+      getDescription = maybe (asks $name.$("A new article on " <>)) return
 
 instance HasCard ArticlesList where
   getCard al@(ArticlesList {collection}) = do
diff --git a/src/JS.hs b/src/JS.hs
index 22f6372..5cd1ad1 100644
--- a/src/JS.hs
+++ b/src/JS.hs
@@ -4,9 +4,8 @@ module JS (
   ) where
 
 import Blog (Blog(..), Path(..))
-import qualified Blog (get)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (ReaderT)
+import Control.Monad.Reader (ReaderT, asks)
 import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
 import Data.ByteString.Lazy.Char8 (pack)
 import qualified Files (find)
@@ -28,9 +27,9 @@ var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]
 
 generate :: ReaderT Blog IO ()
 generate = do
-  destinationDir <- (</> "js") <$> (Blog.get $path.$root)
+  destinationDir <- (</> "js") <$> (asks $path.$root)
   blogJSON <- exportBlog
-  remarkablePath <- Blog.get $path.$remarkableConfig
+  remarkablePath <- asks $path.$remarkableConfig
   liftIO $ do
     remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
     let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]