From e6f0699662dbd026cb7ad0400057befb2a330c7c Mon Sep 17 00:00:00 2001
From: "Yann Esposito (Yogsototh)" <yann.esposito@gmail.com>
Date: Sun, 23 Dec 2018 08:45:56 +0100
Subject: [PATCH] CSS-only show/hide comments

---
 src/Aggreact/Comments.hs | 45 +++++++++++++++++---------------
 src/Aggreact/Css.hs      | 55 +++++++++++++++++++++++++++-------------
 2 files changed, 63 insertions(+), 37 deletions(-)

diff --git a/src/Aggreact/Comments.hs b/src/Aggreact/Comments.hs
index 7087f2f..62b0471 100644
--- a/src/Aggreact/Comments.hs
+++ b/src/Aggreact/Comments.hs
@@ -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
-    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)
+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
-  let cid = UUID.toString (fromId (id comment))
-  H.div H.! A.id (fromString cid) H.! A.class_ "metas" $ do
-      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.pre $ H.text (toS (content comment))
-  H.a H.! A.href (fromString ("/comment/" <> cid)) $ "reply"
+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 }
diff --git a/src/Aggreact/Css.hs b/src/Aggreact/Css.hs
index a5ff1d3..290e3a9 100644
--- a/src/Aggreact/Css.hs
+++ b/src/Aggreact/Css.hs
@@ -1,7 +1,8 @@
 module Aggreact.Css where
 
-import Protolude
-import Clay
+import           Protolude hiding ((&), div)
+
+import           Clay
 
 yBorderColor :: Color
 yBorderColor = grey
@@ -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)