Fix signature that was too general in class + add the actual module that was supposedly added three commits ago (38846e)
This commit is contained in:
parent
f7442f5b37
commit
844cc5a638
2 changed files with 45 additions and 1 deletions
44
src/ArticlesList.hs
Normal file
44
src/ArticlesList.hs
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module ArticlesList (
|
||||||
|
ArticlesList(..)
|
||||||
|
, otherLink
|
||||||
|
, otherUrl
|
||||||
|
, pageTitle
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Article (Article)
|
||||||
|
import Data.Text (Text, pack)
|
||||||
|
import System.FilePath.Posix ((</>))
|
||||||
|
|
||||||
|
data ArticlesList = ArticlesList {
|
||||||
|
tagged :: Maybe String
|
||||||
|
, full :: Bool
|
||||||
|
, featured :: [Article]
|
||||||
|
}
|
||||||
|
|
||||||
|
otherUrl :: ArticlesList -> Text
|
||||||
|
otherUrl (ArticlesList {full, tagged}) =
|
||||||
|
if full
|
||||||
|
then pack $ url tagged
|
||||||
|
else pack $ url tagged </> "all.html"
|
||||||
|
where
|
||||||
|
url = maybe "/" ("/" </>)
|
||||||
|
|
||||||
|
otherLink :: ArticlesList -> Text
|
||||||
|
otherLink (ArticlesList {full}) = pack $
|
||||||
|
if full
|
||||||
|
then "See only latest"
|
||||||
|
else "See all"
|
||||||
|
|
||||||
|
pageTitle :: ArticlesList -> Text
|
||||||
|
pageTitle (ArticlesList {full, tagged}) = pack $
|
||||||
|
(if full then "All" else "Latest") ++ " articles" ++ maybe "" (" tagged " ++) tagged
|
||||||
|
|
||||||
|
{-
|
||||||
|
pageTitle =
|
||||||
|
(if full then "All" else "Latest") ++ " articles" ++ maybe "" (" tagged " ++) category
|
||||||
|
|
||||||
|
p_ $ if full
|
||||||
|
then a_ [href_ . pack $ url category] "See only latest"
|
||||||
|
else a_ [href_ . pack $ url category </> "all.html"] "See all"
|
||||||
|
-}
|
|
@ -17,7 +17,7 @@ import System.FilePath.Posix ((</>), (<.>))
|
||||||
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
||||||
|
|
||||||
class Page a where
|
class Page a where
|
||||||
content :: Monad m => a -> HtmlT m ()
|
content :: a -> HtmlGenerator ()
|
||||||
|
|
||||||
instance Page Article where
|
instance Page Article where
|
||||||
content (Article {fullContents, urlPath}) =
|
content (Article {fullContents, urlPath}) =
|
||||||
|
|
Loading…
Reference in a new issue