From 8c87c7a1df04fddfb954d87da167adb227768534 Mon Sep 17 00:00:00 2001
From: "Yann Esposito (Yogsototh)" <yann.esposito@gmail.com>
Date: Sun, 23 Dec 2018 23:37:19 +0100
Subject: [PATCH] Fixed comment POST

---
 src/Aggreact/Comments.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/src/Aggreact/Comments.hs b/src/Aggreact/Comments.hs
index b9ca30f..24935d3 100644
--- a/src/Aggreact/Comments.hs
+++ b/src/Aggreact/Comments.hs
@@ -168,9 +168,11 @@ instance ToJSON    NewComment where
 instance FormI.FromHttpApiData ParentId where
   parseUrlPiece s = do
     txt <- FormI.parseUrlPiece s
-    case UUID.fromText txt of
-      Nothing   -> Left "Parent ID is not an UUID"
-      Just uuid -> return (ParentId (Just uuid))
+    if Text.null txt
+      then return (ParentId Nothing)
+      else case UUID.fromText txt of
+               Nothing   -> Left $ "Parent ID is not an UUID (" <> txt <> ")"
+               Just uuid -> return (ParentId (Just uuid))
 instance FormI.FromHttpApiData Slug    where parseUrlPiece = fmap Slug . FormI.parseUrlPiece
 instance FormI.FromHttpApiData Content where parseUrlPiece = fmap Content . FormI.parseUrlPiece
 instance FormI.FromHttpApiData UserId where parseUrlPiece = fmap UserId . FormI.parseUrlPiece
@@ -327,7 +329,7 @@ instance H.ToMarkup CommentPage where
         H.text " for "
         extlink sl sl
       displayComment (commentPageComment cp) (commentPageViewTime cp) (return ())
-      commentForm sl "anonymous coward" (cvt cid)
+      commentForm sl "anonymous coward" (Just (cvt cid))
 
 data CommentsPage =
   CommentsPage
@@ -346,7 +348,7 @@ instance H.ToMarkup CommentsPage where
       H.h2 $ do
         H.text "Comments for "
         H.a ! A.href (cvt (url cp)) $ H.text (url cp)
-      commentForm (url cp) "anonymous coward" ""
+      commentForm (url cp) "anonymous coward" Nothing
       H.ul $ traverse_ (showChildren (comments cp) (viewTime cp)) (IxSet.toList roots)
 
 fromId :: Id -> UUID
@@ -356,11 +358,13 @@ fromUserId (UserId x) = x
 unSlug :: Slug -> Text
 unSlug (Slug x) = x
 
-commentForm :: StringConv a [Char] => a -> H.AttributeValue -> H.AttributeValue -> H.Html
-commentForm slug user parent =
+commentForm :: StringConv a [Char] => a -> H.AttributeValue -> (Maybe H.AttributeValue) -> H.Html
+commentForm slug user mparent =
   H.form ! A.action "/comments" ! A.method "post" $ do
     H.input ! A.type_ "hidden" ! A.name "userid" ! A.value user
-    H.input ! A.type_ "hidden" ! A.name "parent" ! A.value parent
+    case mparent of
+      Just parent -> H.input ! A.type_ "hidden" ! A.name "parent" ! A.value parent
+      _ -> return ()
     H.input ! A.type_ "hidden" ! A.name "slug" ! A.value (cvt slug)
     (H.textarea ! A.name "content" ! A.rows "6" ! A.cols "60" ! A.maxlength "5000") ""
     H.br