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

CSS-only show/hide comments

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2018-12-23 08:45:56 +01:00
parent db134feab2
commit e6f0699662
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
2 changed files with 63 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/Aggreact/Comments.hs
View file

@ -287,7 +287,7 @@ instance ToJSON CommentPage where
instance H.ToMarkup CommentPage where instance H.ToMarkup CommentPage where
toMarkup cp = boilerplate $ do toMarkup cp = boilerplate $ do
H.h2 $ H.a H.! A.href (fromString (toS (commentPageUrl cp))) $ H.text (commentPageUrl cp) H.h2 $ H.a H.! A.href (fromString (toS (commentPageUrl cp))) $ H.text (commentPageUrl cp)
displayComment (commentPageComment cp) (commentPageViewTime cp) displayComment (commentPageComment cp) (commentPageViewTime cp) (return ())
commentForm (unSlug (slug (commentPageComment cp))) "anonymous coward" (fromString (toS (commentPageUrl cp))) commentForm (unSlug (slug (commentPageComment cp))) "anonymous coward" (fromString (toS (commentPageUrl cp)))
data CommentsPage = data CommentsPage =
@ -326,26 +326,31 @@ commentForm slug user parent =
H.input H.! A.type_ "submit" H.! A.value "add comment" H.input H.! A.type_ "submit" H.! A.value "add comment"
showChildren :: IxSet.IxSet Comment -> UTCTime -> Comment -> H.Markup showChildren :: IxSet.IxSet Comment -> UTCTime -> Comment -> H.Markup
showChildren cs vt comment = showChildren cs vt comment = H.li $
H.li $ do displayComment comment vt $ do
displayComment comment vt
let children = cs IxSet.@= ParentId (Just (fromId (id comment))) let children = cs IxSet.@= ParentId (Just (fromId (id comment)))
if IxSet.null children if IxSet.null children
then return () then return ()
else H.ul $ traverse_ (showChildren cs vt) (IxSet.toList children) else H.ul $ traverse_ (showChildren cs vt) (IxSet.toList children)
displayComment :: Comment -> UTCTime -> H.Markup displayComment :: Comment -> UTCTime -> H.Markup -> H.Markup
displayComment comment vt = do displayComment comment vt children = do
let inputid = "toggle-" <> UUID.toString (fromId (id comment))
H.input H.! A.type_ "checkbox" H.! A.class_ "toggleinput" H.! A.id (fromString inputid)
H.div $ do
let cid = UUID.toString (fromId (id comment)) let cid = UUID.toString (fromId (id comment))
H.div H.! A.id (fromString cid) H.! A.class_ "metas" $ do H.div H.! A.id (fromString cid) H.! A.class_ "metas" $ do
H.label H.! A.for (fromString inputid) H.!A.class_ "togglelabel" $ (H.span (H.text "[-]"))
H.a H.! A.href (fromString ('#':cid)) $ "§ " H.a H.! A.href (fromString ('#':cid)) $ "§ "
H.text (fromUserId (userid comment)) H.text (fromUserId (userid comment))
H.span H.! A.class_ "time" $ do H.span H.! A.class_ "time" $ do
H.text " - " H.text " - "
H.text . toS . humanReadableDuration . realToFrac $ diffUTCTime vt (created comment) H.text . toS . humanReadableDuration . realToFrac $ diffUTCTime vt (created comment)
H.text " ago" H.text " ago"
H.div H.! A.class_ "tohide" $ do
H.pre $ H.text (toS (content comment)) H.pre $ H.text (toS (content comment))
H.a H.! A.href (fromString ("/comment/" <> cid)) $ "reply" H.a H.! A.href (fromString ("/comment/" <> cid)) $ "reply"
children
data DBConf = DBConf { filePath :: FilePath } data DBConf = DBConf { filePath :: FilePath }

53
src/Aggreact/Css.hs
View file

@ -1,6 +1,7 @@
module Aggreact.Css where module Aggreact.Css where
import Protolude import Protolude hiding ((&), div)
import Clay import Clay
yBorderColor :: Color yBorderColor :: Color
@ -61,24 +62,44 @@ genCss = do
x ? do x ? do
fontWeight bold fontWeight bold
fontSize (em 1) fontSize (em 1)
h1 ? color solyellow h1 ? do
h1 # before ? content (stringContent "# ") color solyellow
h2 ? color solorange before & content (stringContent "# ")
h2 # before ? content (stringContent "## ") h2 ? do
h3 ? color solred color solorange
h3 # before ? content (stringContent "### ") before & content (stringContent "## ")
h4 ? color solmagenta h3 ? do
h4 # before ? content (stringContent "#### ") color solred
h5 ? color solviolet before & content (stringContent "### ")
h5 # before ? content (stringContent "##### ") h4 ? do
h6 ? color solblue color solmagenta
h6 # before ? content (stringContent "###### ") before & content (stringContent "#### ")
a ? color solblue h5 ? do
a # visited ? color solviolet color solviolet
a # hover ? color solorange before & content (stringContent "##### ")
h6 ? do
color solblue
before & content (stringContent "###### ")
a ? do
color solblue
visited & color solviolet
hover & color solorange
label ? do label ? do
minWidth (em 7) minWidth (em 7)
display inlineBlock display inlineBlock
label # byClass "togglelabel" ? do
minWidth (em 2)
display inlineBlock
content (stringContent "[-]")
cursor pointer
input # ("type" |= "checkbox") ?
display none
input # ("type" |= "checkbox") # checked |+ div |> label |> span ?
display none
input # ("type" |= "checkbox") # checked |+ div |> label ?
after & content (stringContent "[+]")
input # ("type" |= "checkbox") # checked |+ div |> div # byClass "tohide" ?
display none
pre ? do pre ? do
fontFamily ["Menlo"] [monospace] fontFamily ["Menlo"] [monospace]
marginTop (px 0) marginTop (px 0)