mforced & aforced

src/Handler/Utils/Form.hs

@@ -40,6 +40,8 @@ import qualified Database.Esqueleto.Internal.Sql as E
 
 import qualified Data.Set as Set
 
+import Control.Monad.Writer.Class
+
 ------------------------------------------------
 -- Unique Form Identifiers to avoid accidents --
 ------------------------------------------------
@@ -426,3 +428,26 @@ optionsPersistCryptoId filts ords toDisplay = fmap mkOptionList $ do
                  , optionInternalValue = key
                  , optionExternalValue = toPathPiece (cId :: CryptoID UUID (Key a))
                  }) cPairs
+
+mforced :: (site ~ HandlerSite m, MonadHandler m)
+        => Field m a -> FieldSettings site -> a -> MForm m (FormResult a, FieldView site)
+mforced Field{..} FieldSettings{..} val = do
+  tell fieldEnctype
+  name <- maybe newFormIdent return fsName
+  theId <- lift $ maybe newIdent return fsId
+  mr <- getMessageRender
+  let fsAttrs' = fsAttrs <> [("disabled", "")]
+  return ( FormSuccess val
+         , FieldView
+           { fvLabel = toHtml $ mr fsLabel
+           , fvTooltip = toHtml <$> fmap mr fsTooltip
+           , fvId = theId
+           , fvInput = fieldView theId name fsAttrs' (Right val) False
+           , fvErrors = Nothing
+           , fvRequired = False
+           }
+         )
+
+aforced :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
+        => Field m a -> FieldSettings site -> a -> AForm m a
+aforced field settings val = formToAForm $ second pure <$> mforced field settings val