Get rid of useless Blog.get that was actually a re-implementation of MonadReader's 'asks'

This commit is contained in:
Tissevert 2020-05-07 17:09:21 +02:00
parent e180fef293
commit 58d2f3c1c2
4 changed files with 16 additions and 22 deletions

View file

@ -9,7 +9,6 @@ module Blog (
, URL(..) , URL(..)
, Wording , Wording
, build , build
, get
, template , template
) where ) where
@ -61,9 +60,6 @@ type Renderer m = (MonadIO m, MonadReader Blog m)
template :: Renderer m => String -> Environment -> m Text template :: Renderer m => String -> Environment -> m Text
template key environment = asks templates >>= render key environment 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 :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article)
keepOrWarn accumulator (Left parseErrors) = keepOrWarn accumulator (Left parseErrors) =
forM [show parseErrors, "=> Ignoring this article"] putStrLn forM [show parseErrors, "=> Ignoring this article"] putStrLn

View file

@ -10,7 +10,6 @@ import ArticlesList (
ArticlesList(..), description, getArticles, otherURL, rssLinkTexts ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
) )
import Blog (Blog(..), Path(..), Skin(..), URL(..), template) import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
import qualified Blog (get)
import Control.Monad.Reader (ReaderT, asks) import Control.Monad.Reader (ReaderT, asks)
import qualified Data.Map as Map (keys) import qualified Data.Map as Map (keys)
import Data.Text (pack, empty) import Data.Text (pack, empty)
@ -36,7 +35,7 @@ instance Page Article where
instance Page ArticlesList where instance Page ArticlesList where
content al@(ArticlesList {full}) = do content al@(ArticlesList {full}) = do
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount) preview <- Article.preview <$> (asks $skin.$previewLinesCount)
h2_ . toHtml =<< description al h2_ . toHtml =<< description al
ul_ $ do ul_ $ do
asks hasRSS >>= rssLink asks hasRSS >>= rssLink
@ -55,7 +54,7 @@ instance Page ArticlesList where
article :: Bool -> Article -> HtmlGenerator () article :: Bool -> Article -> HtmlGenerator ()
article raw (Article {key, body, Article.title}) = do 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 article_ [id_ $ pack key] (do
header_ (do header_ (do
a_ [href_ $ pack url] . h1_ $ toHtml title a_ [href_ $ pack url] . h1_ $ toHtml title
@ -73,7 +72,7 @@ defaultBanner :: HtmlGenerator ()
defaultBanner = do defaultBanner = do
div_ [id_ "header"] ( div_ [id_ "header"] (
a_ [href_ "/"] ( a_ [href_ "/"] (
h1_ . toHtml =<< Blog.get name h1_ . toHtml =<< asks name
) )
) )
@ -88,19 +87,19 @@ page aPage =
doctypehtml_ (do doctypehtml_ (do
head_ (do head_ (do
meta_ [charset_ "utf-8"] meta_ [charset_ "utf-8"]
title_ . toHtml =<< Blog.get name title_ . toHtml =<< asks name
script_ [src_ "/js/unit.js"] empty script_ [src_ "/js/unit.js"] empty
script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/remarkable.min.js"] empty
script_ [src_ "/js/hablo.js"] empty script_ [src_ "/js/hablo.js"] empty
optional faviconLink =<< (Blog.get $skin.$favicon) optional faviconLink =<< (asks $skin.$favicon)
optional (Card.make aPage) =<< (Blog.get $urls.$cards) optional (Card.make aPage) =<< (asks $urls.$cards)
(Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw (asks $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
) )
body_ (do body_ (do
maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner) maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
div_ [id_ "navigator"] (do div_ [id_ "navigator"] (do
h2_ . toHtml =<< template "tagsList" [] h2_ . toHtml =<< template "tagsList" []
ul_ . mapM_ tag . Map.keys =<< Blog.get tags ul_ . mapM_ tag . Map.keys =<< asks tags
) )
div_ [id_ "contents"] $ content aPage div_ [id_ "contents"] $ content aPage
) )

View file

@ -11,10 +11,10 @@ import qualified Article (Article(..))
import ArticlesList (ArticlesList(..)) import ArticlesList (ArticlesList(..))
import qualified ArticlesList (description) import qualified ArticlesList (description)
import Blog (Blog(..), Renderer, Skin(..)) import Blog (Blog(..), Renderer, Skin(..))
import qualified Blog (get)
import Collection (Collection(..)) import Collection (Collection(..))
import qualified Collection (title) import qualified Collection (title)
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad.Reader (asks)
import qualified Data.Map as Map (lookup) import qualified Data.Map as Map (lookup)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Lucid (HtmlT, content_, meta_) import Lucid (HtmlT, content_, meta_)
@ -46,8 +46,8 @@ make element siteURL = do
og "type" cardType og "type" cardType
og "title" $ pack title og "title" $ pack title
og "description" description og "description" description
maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage)) maybeImage =<< ((image <|>) <$> (asks $skin.$cardImage))
og "site_name" =<< (Blog.get $name.$pack) og "site_name" =<< (asks $name.$pack)
where where
maybeImage = maybe (return ()) (og "image" . pack . (siteURL++)) maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))
@ -62,7 +62,7 @@ instance HasCard Article.Article where
, urlPath = "/articles/" ++ title ++ ".html" , urlPath = "/articles/" ++ title ++ ".html"
} }
where where
getDescription = maybe (Blog.get $name.$("A new article on " <>)) return getDescription = maybe (asks $name.$("A new article on " <>)) return
instance HasCard ArticlesList where instance HasCard ArticlesList where
getCard al@(ArticlesList {collection}) = do getCard al@(ArticlesList {collection}) = do

View file

@ -4,9 +4,8 @@ module JS (
) where ) where
import Blog (Blog(..), Path(..)) import Blog (Blog(..), Path(..))
import qualified Blog (get)
import Control.Monad.IO.Class (MonadIO(..)) 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 (ByteString, concat, readFile, writeFile)
import Data.ByteString.Lazy.Char8 (pack) import Data.ByteString.Lazy.Char8 (pack)
import qualified Files (find) import qualified Files (find)
@ -28,9 +27,9 @@ var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]
generate :: ReaderT Blog IO () generate :: ReaderT Blog IO ()
generate = do generate = do
destinationDir <- (</> "js") <$> (Blog.get $path.$root) destinationDir <- (</> "js") <$> (asks $path.$root)
blogJSON <- exportBlog blogJSON <- exportBlog
remarkablePath <- Blog.get $path.$remarkableConfig remarkablePath <- asks $path.$remarkableConfig
liftIO $ do liftIO $ do
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)] let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]