yogsototh/aggreact
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Display enhancements

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2019-02-22 08:31:47 +01:00
parent 480f646648
commit 8874e8dc6d
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
1 changed files with 34 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
src/Aggreact/Homepage.hs
View file

@ -1,23 +1,23 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE NamedWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE NamedWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{- |
Module : Aggreact.Comments
Description : Example of a library file.
@ -39,13 +39,14 @@ module Aggreact.Homepage
import Protolude
import Aggreact.Comments (Comment, CommentHandler(..),
import Aggreact.Comments (Comment, CommentHandler (..),
Slug (..), displayOneComment)
import Aggreact.Css (genCss)
import Aggreact.Html (boilerplate, urlEncode)
import Aggreact.User (User,loginWidget)
import Aggreact.Html (boilerplate, extlink, urlEncode)
import Aggreact.User (User, loginWidget)
import Clay (Css)
import Data.String (IsString (..))
import qualified Data.Text as Text
import Data.Time (UTCTime, getCurrentTime)
import Servant
import Servant.Auth.Server
@ -85,7 +86,6 @@ getHomepage muser commentHandler =
<*> getCurrentTime
<*> return muser
instance H.ToMarkup Homepage where
toMarkup Homepage {..} = boilerplate (loginWidget muser) $ do
H.p "Bienvenue sur Aggreact!"
@ -97,5 +97,14 @@ instance H.ToMarkup Homepage where
H.ul $ traverse_ (`displayOneComment` viewTime) latestComments
where htmlSlug (Slug s,n) =
H.li $ do
H.a H.! A.href (fromString (toS ("/comments/" <> urlEncode (toS s)))) $ H.text s
H.div H.! A.class_ "metas" $ H.text (show n <> " comments")
H.span H.! A.class_ "metas" $ do
H.a H.! A.href (fromString (toS ("/comments/" <> urlEncode (toS s)))) $
H.text (show n <> " comments")
H.text ": "
extlink s (shorten 60 s)
shorten :: Int -> Text -> Text
shorten maxlen t =
if Text.length t > (maxlen - 1)
then Text.take maxlen t <> "…"
else t