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
toMarkup cp = boilerplate $ do
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)))
data CommentsPage =
@ -326,26 +326,31 @@ commentForm slug user parent =
H.input H.! A.type_ "submit" H.! A.value "add comment"
showChildren :: IxSet.IxSet Comment -> UTCTime -> Comment -> H.Markup
showChildren cs vt comment =
H.li $ do
displayComment comment vt
showChildren cs vt comment = H.li $
displayComment comment vt $ do
let children = cs IxSet.@= ParentId (Just (fromId (id comment)))
if IxSet.null children
then return ()
else H.ul $ traverse_ (showChildren cs vt) (IxSet.toList children)
displayComment :: Comment -> UTCTime -> H.Markup
displayComment comment vt = do
displayComment :: Comment -> UTCTime -> H.Markup -> H.Markup
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))
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.text (fromUserId (userid comment))
H.span H.! A.class_ "time" $ do
H.text " - "
H.text . toS . humanReadableDuration . realToFrac $ diffUTCTime vt (created comment)
H.text " ago"
H.div H.! A.class_ "tohide" $ do
H.pre $ H.text (toS (content comment))
H.a H.! A.href (fromString ("/comment/" <> cid)) $ "reply"
children
data DBConf = DBConf { filePath :: FilePath }

53
src/Aggreact/Css.hs
View file

@ -1,6 +1,7 @@
module Aggreact.Css where
import Protolude
import Protolude hiding ((&), div)
import Clay
yBorderColor :: Color
@ -61,24 +62,44 @@ genCss = do
x ? do
fontWeight bold
fontSize (em 1)
h1 ? color solyellow
h1 # before ? content (stringContent "# ")
h2 ? color solorange
h2 # before ? content (stringContent "## ")
h3 ? color solred
h3 # before ? content (stringContent "### ")
h4 ? color solmagenta
h4 # before ? content (stringContent "#### ")
h5 ? color solviolet
h5 # before ? content (stringContent "##### ")
h6 ? color solblue
h6 # before ? content (stringContent "###### ")
a ? color solblue
a # visited ? color solviolet
a # hover ? color solorange
h1 ? do
color solyellow
before & content (stringContent "# ")
h2 ? do
color solorange
before & content (stringContent "## ")
h3 ? do
color solred
before & content (stringContent "### ")
h4 ? do
color solmagenta
before & content (stringContent "#### ")
h5 ? do
color solviolet
before & content (stringContent "##### ")
h6 ? do
color solblue
before & content (stringContent "###### ")
a ? do
color solblue
visited & color solviolet
hover & color solorange
label ? do
minWidth (em 7)
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
fontFamily ["Menlo"] [monospace]
marginTop (px 0)