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
@ -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)