From 24dbaf36bca4402d750d9c7ed69108f1d6d5fb4b Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@uniworx.de>
Date: Tue, 30 Jan 2024 21:51:25 +0100
Subject: [PATCH] chore(form): add uuidField

---
 src/Utils/Form.hs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index e79761885..d6cf508f7 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2023 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2023-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Felix Hamann <felix.hamann@campus.lmu.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Sarah Vaupel <vaupel.sarah@campus.lmu.de>, Steffen Jost <jost@cip.ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -19,7 +19,7 @@ import Settings
 import Utils.Parameters
 import Utils.Lens
 
-import Text.Blaze (Markup)
+import Text.Blaze (Markup, toMarkup)
 import qualified Text.Blaze.Internal as Blaze (null)
 import qualified Data.Text as T
 import qualified Data.Char as C
@@ -27,6 +27,7 @@ import qualified Data.Char as C
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import Data.Universe
+import qualified Data.UUID as UUID
 
 import Data.List (nub, (!!))
 import Data.Map.Lazy ((!))
@@ -81,6 +82,9 @@ import qualified Data.ByteString.Base64.URL as Base64 (encodeUnpadded)
 import qualified Data.ByteString as BS
 
 
+fvWidget :: FieldView site -> WidgetFor site ()
+fvWidget FieldView{..} = $(widgetFile "widgets/field-view/field-view")
+
 ------------
 -- Fields --
 ------------
@@ -116,6 +120,17 @@ commentField msg = Field {..}
     fieldView  _ _ _ _ _  = msg2widget msg
     fieldEnctype          = UrlEncoded
 
+uuidField :: Monad m => Field m UUID
+uuidField = Field{..}
+  where
+    fieldParse = parseHelperGen $ maybe (Left $ tshow "Invalid UUID!") Right . UUID.fromText
+    fieldView fvId (toMarkup -> fvLabel) fvAttrs fvInput' fvRequired = fvWidget FieldView{..}
+      where fvTooltip = Nothing
+            fvErrors = either (Just . toMarkup) (const Nothing) fvInput'
+            fvInput = [whamlet|<input type="text" *{fvAttrs} name=#{fvLabel} :fvRequired:required value=#{fvValue}>|]
+            fvValue = either id UUID.toText fvInput'
+    fieldEnctype = UrlEncoded
+
 --------------------
 -- Field Settings --
 --------------------
@@ -1257,10 +1272,6 @@ formSection formSectionTitle = do
       , fvInput    = mempty
       })
 
-fvWidget :: FieldView site -> WidgetFor site ()
-fvWidget FieldView{..} = $(widgetFile "widgets/field-view/field-view")
-
-
 doFormHoneypots :: ( MonadHandler m
                    , HasAppSettings (HandlerSite m)
                    , YesodAuth (HandlerSite m)