{-# language OverloadedStrings #-}
{-# language MultiParamTypeClasses #-}
{-# language FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Web.Scotty.Form where
import Data.Text (Text)
import Ditto.Core hiding (view)
import Ditto.Lucid
import Ditto.Types
import Lucid (HtmlT, Html)
import Web.Scotty
import qualified Data.Text.Lazy as TL
instance Environment ActionM Text where
environment formId = do
qp <- params
case lookup (TL.pack $ show formId) qp of
Nothing -> pure Missing
Just x -> pure (Found $ TL.toStrict x)
type ScottyForm a = Form ActionM Text Text (Html ()) a
reform :: (Monoid view)
=> ([(Text, Text)] -> view -> view)
-> Text
-> Form ActionM Text err view a
-> ActionM (Result err a, view)
reform toForm prefix formlet = do
reformSingle toForm' prefix formlet
where
toForm' hidden view = toForm (("formname", prefix) : hidden) view
reformSingle
:: ([(Text, Text)] -> view -> view)
-> Text
-> Form ActionM Text err view a
-> ActionM (Result err a, view)
reformSingle toForm prefix formlet = do
(View viewf, res) <- runForm prefix formlet
case res of
Error errs -> pure (Error errs, toForm [] $ viewf errs)
Ok (Proved _ unProved') -> pure (Ok unProved', toForm [] $ viewf [])
simpleReformGET :: (Show b, Applicative f)
=> Text
-> Form ActionM Text err (HtmlT f ()) b
-> ActionM (Result err b, HtmlT f ())
simpleReformGET action form = reform (formGenGET action) "reform" form
simpleReformPOST :: (Show b, Applicative f)
=> Text
-> Form ActionM Text err (HtmlT f ()) b
-> ActionM (Result err b, HtmlT f ())
simpleReformPOST action form = reform (formGenPOST action) "reform" form