scotty-form 0.2.0.0 → 0.3.0.0
raw patch · 2 files changed
+35/−15 lines, 2 filesdep ~luciddep ~scottydep ~text
Dependency ranges changed: lucid, scotty, text
Files
- scotty-form.cabal +4/−4
- src/Web/Scotty/Form.hs +31/−11
scotty-form.cabal view
@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: scotty-form-version: 0.2.0.0+version: 0.3.0.0 synopsis: Html form validation using `ditto` description: Formlet library for `scotty` using `lucid` and `ditto` -- bug-reports:@@ -28,9 +28,9 @@ -- other-extensions: build-depends: base >=4.12 && <4.14- , scotty- , text- , lucid+ , text >= 1.2.4 && < 1.3+ , lucid >= 2.9.12 && < 2.10+ , scotty >= 0.12 && < 0.13 , ditto >= 0.4 && <= 0.5 , ditto-lucid >= 0.4 && <= 0.5 hs-source-dirs: src
src/Web/Scotty/Form.hs view
@@ -1,6 +1,7 @@ {-# language OverloadedStrings #-} {-# language MultiParamTypeClasses #-} {-# language FlexibleInstances #-}+{-# language TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -12,21 +13,35 @@ import Ditto.Types import Lucid (HtmlT, Html) import Web.Scotty+import Ditto.Backend+import qualified Data.Text as T import qualified Data.Text.Lazy as TL -instance Environment ActionM Text where+instance Environment ActionM [Param] where environment formId = do qp <- params- case lookup (TL.pack $ show formId) qp of- Nothing -> pure Missing- Just x -> pure (Found $ TL.toStrict x)+ let !formId' = TL.fromStrict $ encodeFormId formId+ case filter (\(x,_) -> x == formId') qp of+ [] -> pure Missing+ xs -> pure (Found xs) -type ScottyForm a = Form ActionM Text Text (Html ()) a+instance FormInput [Param] where+ type FileType [Param] = ()+ getInputStrings xs = fmap (TL.unpack . snd) xs+ getInputFile _ = Left $ commonFormError $ (NoFileFound [("","No support for file uploads")] :: CommonFormError [Param]) +instance FormError [Param] Text where+ commonFormError e = commonFormErrorText encQP e+ where+ encQP [] = ""+ encQP xs = T.intercalate ", " (fmap (TL.toStrict . snd) xs)++type ScottyForm a = Form ActionM [Param] Text (Html ()) a+ reform :: (Monoid view) => ([(Text, Text)] -> view -> view) -- ^ wrap raw form html inside a <form> tag -> Text -- ^ form name prefix- -> Form ActionM Text err view a -- ^ the formlet+ -> Form ActionM [Param] err view a -- ^ the formlet -> ActionM (Result err a, view) reform toForm prefix formlet = do reformSingle toForm' prefix formlet@@ -36,7 +51,7 @@ reformSingle :: ([(Text, Text)] -> view -> view) -> Text- -> Form ActionM Text err view a+ -> Form ActionM [Param] err view a -> ActionM (Result err a, view) reformSingle toForm prefix formlet = do (View viewf, res) <- runForm prefix formlet@@ -44,15 +59,20 @@ Error errs -> pure (Error errs, toForm [] $ viewf errs) Ok (Proved _ unProved') -> pure (Ok unProved', toForm [] $ viewf []) -simpleReformGET :: (Show b, Applicative f) +simpleReformGET :: (Applicative f) => Text- -> Form ActionM Text err (HtmlT f ()) b + -> Form ActionM [Param] err (HtmlT f ()) b -> ActionM (Result err b, HtmlT f ()) simpleReformGET action form = reform (formGenGET action) "reform" form -simpleReformPOST :: (Show b, Applicative f) +simpleReformPOST :: (Applicative f) => Text- -> Form ActionM Text err (HtmlT f ()) b + -> Form ActionM [Param] err (HtmlT f ()) b -> ActionM (Result err b, HtmlT f ()) simpleReformPOST action form = reform (formGenPOST action) "reform" form +-- | lift a function which parses @Text@ into a function which parses a @[Param]@+liftParser :: (Text -> Either Text a) -> ([Param] -> Either Text a)+liftParser f [(_,x)] = f (TL.toStrict x)+liftParser _ [] = Left "Unexpected empty query param list"+liftParser _ _ = Left "Unexpected multiple query param list"