diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 2a568432e..af7379f8c 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -481,6 +481,30 @@ secretJsonField = Field{..} |] fieldEnctype = UrlEncoded +boolField :: ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => Field m Bool +boolField = Field + { fieldParse = \e _ -> return $ boolParser e + , fieldView = \theId name attrs val isReq -> $(widgetFile "widgets/fields/bool") + , fieldEnctype = UrlEncoded + } + where + boolParser [] = Right Nothing + boolParser (x:_) = case x of + "" -> Right Nothing + "none" -> Right Nothing + "yes" -> Right $ Just True + "on" -> Right $ Just True + "no" -> Right $ Just False + "true" -> Right $ Just True + "false" -> Right $ Just False + t -> Left $ SomeMessage $ MsgInvalidBool t + showVal = either (\_ -> False) + + + funcForm :: forall k v m. ( Finite k, Ord k diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 1f1220787..ff88f3065 100644 --- a/src/Import/NoFoundation.hs +++ b/src/Import/NoFoundation.hs @@ -3,7 +3,7 @@ module Import.NoFoundation , MForm ) where -import ClassyPrelude.Yesod as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static) +import ClassyPrelude.Yesod as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static, boolField) import Model as Import import Model.Types.JSON as Import import Model.Migration as Import diff --git a/templates/widgets/fields/bool.hamlet b/templates/widgets/fields/bool.hamlet new file mode 100644 index 000000000..3a837f863 --- /dev/null +++ b/templates/widgets/fields/bool.hamlet @@ -0,0 +1,14 @@ +$newline never +