fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(form): add uuidField

Browse Source
This commit is contained in:
Sarah Vaupel 2024-01-30 21:51:25 +01:00
parent 43bf25a5bd
commit 24dbaf36bc
1 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Utils/Form.hs
View File

@ -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 -- SPDX-License-Identifier: AGPL-3.0-or-later
@ -19,7 +19,7 @@ import Settings
import Utils.Parameters import Utils.Parameters
import Utils.Lens import Utils.Lens
import Text.Blaze (Markup) import Text.Blaze (Markup, toMarkup)
import qualified Text.Blaze.Internal as Blaze (null) import qualified Text.Blaze.Internal as Blaze (null)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Char as C import qualified Data.Char as C
@ -27,6 +27,7 @@ import qualified Data.Char as C
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Universe import Data.Universe
import qualified Data.UUID as UUID
import Data.List (nub, (!!)) import Data.List (nub, (!!))
import Data.Map.Lazy ((!)) import Data.Map.Lazy ((!))
@ -81,6 +82,9 @@ import qualified Data.ByteString.Base64.URL as Base64 (encodeUnpadded)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
fvWidget :: FieldView site -> WidgetFor site ()
fvWidget FieldView{..} = $(widgetFile "widgets/field-view/field-view")
------------ ------------
-- Fields -- -- Fields --
------------ ------------
@ -116,6 +120,17 @@ commentField msg = Field {..}
fieldView _ _ _ _ _ = msg2widget msg fieldView _ _ _ _ _ = msg2widget msg
fieldEnctype = UrlEncoded 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 -- -- Field Settings --
-------------------- --------------------
@ -1257,10 +1272,6 @@ formSection formSectionTitle = do
, fvInput = mempty , fvInput = mempty
}) })
fvWidget :: FieldView site -> WidgetFor site ()
fvWidget FieldView{..} = $(widgetFile "widgets/field-view/field-view")
doFormHoneypots :: ( MonadHandler m doFormHoneypots :: ( MonadHandler m
, HasAppSettings (HandlerSite m) , HasAppSettings (HandlerSite m)
, YesodAuth (HandlerSite m) , YesodAuth (HandlerSite m)