ditto 0.4.1 → 0.5.0

raw patch · 12 files changed

+478/−104 lines, 12 filesdep +dittodep −containersdep ~basedep ~mtldep ~textsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: ditto

Dependencies removed: containers

Dependency ranges changed: base, mtl, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• README.md +42/−0
• Setup.hs +0/−2
• ditto.cabal +76/−8
• src/Ditto/Backend.hs +1/−8
• src/Ditto/Core.hs +9/−23
• src/Ditto/Generalized/Internal.hs +10/−14
• src/Ditto/Generalized/Named.hs +5/−10
• src/Ditto/Generalized/Unnamed.hs +4/−9
• src/Ditto/Proof.hs +5/−12
• src/Ditto/Types.hs +7/−18
• test/Main.hs +294/−0

@@ -0,0 +1,25 @@+# Changelog++## 0.5.0 — 2026-08-27++### Changed+- Prefer GHC 9.10+ (`GHC2024`) with automatic fallback to `GHC2021` / `Haskell2010` on older GHC+- Widen dependency bounds (`base >= 4.14`, `text >= 1.2`) and drop the unused `containers` dependency+- Enable a stricter warning set on GHC 8.10+ (`-Wcompat`, unused packages, missing deriving strategies, …)+- Replace per-module `LANGUAGE` pragmas with cabal `default-extensions`+- Drop redundant constraints from public signatures (`prove`, `inputList`, `inputMaybe`, …); `inputMulti` does not require `FormInput` because decoding is caller-supplied+- Fix `inputFile` so `Default` environment renders an empty upload instead of an error (`Missing` on submit is unchanged)++### Added+- Export `hoistForm`+- Test suite covering decode, `Alternative`, `catchFormError`, `inputMulti`, `inputChoice`, and `inputFile` (including `Missing` submit path)+- GitHub Actions CI: Cabal matrix (GHC 9.6–9.14) and `nix flake check`+- `cabal.project`+- Nix flake (`flake.nix`, `flake.lock`) with `packages`, `checks`, and `devShells` outputs++### Removed+- `Setup.hs` (unused with `build-type: Simple`)++### Packaging+- Nix is flake-only; legacy `default.nix` and `shell.nix` removed+- nixpkgs pinned by rev in `flake.nix` / `flake.lock`

@@ -0,0 +1,42 @@+ditto [![Hackage](https://img.shields.io/hackage/v/ditto.svg)](https://hackage.haskell.org/package/ditto)+=========++![Image of ditto from pokemon](https://i.imgur.com/0i7qeeW.png)+> Its transformation ability is perfect. However, if it is made to laugh, it can't maintain its disguise.++A portable library which provides type-safe form generation and validation.++This core library is intended to be used in conjunction with other libraries such as [scotty-form](http://hackage.haskell.org/package/scotty-form) and [ditto-lucid](http://hackage.haskell.org/package/ditto-lucid).++## Requirements++Tested on GHC 9.6 through 9.14. GHC 9.10+ uses `GHC2024` by default; older supported GHC versions fall back to `GHC2021` or `Haskell2010` with the required extensions enabled in the cabal file.++### Cabal++Use this for day-to-day development (fast incremental rebuilds):++```+cabal test --enable-tests+```++### Nix (flake)++Pinned nixpkgs and package checks:++```+nix build+nix flake check+nix develop+```++- `nix flake check` — build library and run the test suite in an isolated Nix derivation (CI uses this).+- `nix develop` — enter a shell with GHC, `cabal-install`, and HLS; run `cabal test` for iterative work.+- Flake source includes all project files under the repo root (not only git-tracked paths). `flake.lock` pins nixpkgs.++## 0.5.0 upgrade notes++- Recommended toolchain: GHC 9.10+ for `GHC2024`.+- Dependency bounds are intentionally permissive (`base >= 4.14`); older GHC releases remain supported where possible.+- `inputFile`: `Default` environment is an empty upload (no error on initial render); `Missing` on submit still errors.+- `hoistForm` is exported from `Ditto.Core`.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,6 +1,6 @@-cabal-version: 3.0+cabal-version: 3.8 name: ditto-version: 0.4.1+version: 0.5.0 synopsis: ditto is a type-safe HTML form generation and validation library description:   ditto follows in the footsteps of formlets and@@ -14,15 +14,74 @@ copyright:   2012 Jeremy Shaw, Jasper Van der Jeugt, SeeReason Partners LLC,   2019 Zachary Churchill+homepage: https://github.com/goolord/ditto+bug-reports: https://github.com/goolord/ditto/issues category: Web build-type: Simple+extra-doc-files:+  CHANGELOG.md+  README.md+tested-with:+  GHC == 9.6.7+  GHC == 9.8.4+  GHC == 9.10.3+  GHC == 9.12.4+  GHC == 9.14.1  source-repository head   type: git   location: https://github.com/goolord/ditto.git -library+common warnings   ghc-options: -Wall+  if impl(ghc >= 8.10)+  ghc-options:+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-deriving-strategies+    -Wunused-packages+  if impl(ghc >= 9.4)+  ghc-options: -Wredundant-constraints++common extensions+  default-extensions:+    BangPatterns+    DataKinds+    DeriveFoldable+    DeriveFunctor+    DeriveTraversable+    DerivingStrategies+    ExplicitForAll+    FlexibleInstances+    FunctionalDependencies+    GeneralizedNewtypeDeriving+    LambdaCase+    MultiParamTypeClasses+    NamedFieldPuns+    OverloadedStrings+    PatternSynonyms+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TypeApplications+    TypeFamilies+    TypeOperators++common defaults+  import: warnings, extensions+  if impl(ghc >= 9.10)+    default-language: GHC2024+  else+    if impl(ghc >= 9.2)+      default-language: GHC2021+    else+      default-language: Haskell2010++library+  import: defaults   exposed-modules:     Ditto     Ditto.Core@@ -34,9 +93,18 @@   other-modules:     Ditto.Generalized.Internal   build-depends:-      base       >= 4    && < 5-    , containers >= 0.4  && < 1.0-    , mtl        >= 2.0  && < 3.0-    , text       >= 0.11 && < 3.0+      base >= 4.14 && < 5+    , mtl  >= 2.2  && < 3+    , text >= 1.2  && < 3   hs-source-dirs: src-  default-language: Haskell2010++test-suite ditto-test+  import: defaults+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  build-depends:+      base+    , ditto+    , mtl+    , text

@@ -1,10 +1,3 @@-{-# LANGUAGE-    MultiParamTypeClasses-  , TypeFamilies-  , OverloadedStrings-  , FunctionalDependencies-#-}- {- | This module contains two classes. 'FormInput' is a class which is parameterized over the @input@ type used to represent form data in different web frameworks. There should be one instance for each framework, such as Happstack, Snap, WAI, etc. @@ -29,7 +22,7 @@   | MultiFilesFound input   | MultiStringsFound input   | MissingDefaultValue-  deriving (Eq, Ord, Show)+  deriving stock (Eq, Ord, Show)  -- | some default error messages for 'CommonFormError' commonFormErrorStr

@@ -1,18 +1,3 @@-{-# LANGUAGE-    DeriveFunctor-  , FlexibleInstances-  , FunctionalDependencies-  , GeneralizedNewtypeDeriving-  , LambdaCase-  , NamedFieldPuns-  , OverloadedStrings-  , RankNTypes-  , RecordWildCards-  , ScopedTypeVariables-  , StandaloneDeriving-  , TypeApplications-#-}- -- | The core module for @ditto@. -- -- This module provides the @Form@ type and helper functions@@ -53,6 +38,7 @@   , unitRange   , view   , viewForm+  , hoistForm   , pureRes   , liftForm   ) where@@ -79,7 +65,7 @@   { formDecodeInput :: input -> m (Either err a) -- ^ Decode the value from the input   , formInitialValue :: m a -- ^ The initial value   , formFormlet :: FormState m (View err view, Result err (Proved a)) -- ^ A @FormState@ which produces a @View@ and a @Result@-  } deriving (Functor)+  } deriving stock (Functor)  instance (Monad m, Monoid view) => Applicative (Form m input err view) where @@ -122,7 +108,7 @@     (v2, _) <- formFormlet f2     pure (v1 <> v2, r) -instance (Environment m input, Monoid view, FormError input err) => Monad (Form m input err view) where+instance (Environment m input, Monoid view) => Monad (Form m input err view) where   form >>= f =     let mres = snd <$> runForm "" form     in Form@@ -189,7 +175,7 @@  -- | Run the form, but always return the initial value newtype NoEnvironment input m a = NoEnvironment { getNoEnvironment ::  m a }-  deriving (Monad, Functor, Applicative)+  deriving newtype (Functor, Applicative, Monad)  instance Monad m => Environment (NoEnvironment input m) input where   environment = noEnvironment@@ -200,9 +186,9 @@  -- | Run the form, but with a given @environment@ function newtype WithEnvironment input m a = WithEnvironment { getWithEnvironment :: ReaderT (FormId -> m (Value input)) m a }-  deriving (Monad, Functor, Applicative)+  deriving newtype (Functor, Applicative, Monad) -deriving instance Monad m => MonadReader (FormId -> m (Value input)) (WithEnvironment input m)+deriving newtype instance Monad m => MonadReader (FormId -> m (Value input)) (WithEnvironment input m)  instance MonadTrans (WithEnvironment input) where   lift = WithEnvironment . lift@@ -416,8 +402,8 @@  -- | Lift a monad morphism from @m@ to @n@ into a monad morphism from @(Form m)@ to @(Form n)@ -- eg. @newtype@s, @lift@s-hoistForm :: (Monad f)-  => (forall x. m x -> f x)+hoistForm+  :: (forall x. m x -> f x)   -> Form m input err view a   -> Form f input err view a hoistForm f Form{formDecodeInput, formInitialValue, formFormlet} = Form@@ -470,7 +456,7 @@   pure (unView v [])  -- | lift the result of a decoding to a @Form@-pureRes :: (Monad m, Monoid view, FormError input err)+pureRes :: (Monad m, Monoid view)   => a   -> Either err a   -> Form m input err view a

@@ -1,10 +1,3 @@-{-# LANGUAGE-    NamedFieldPuns-  , ScopedTypeVariables-  , LambdaCase-  , TypeFamilies-#-}- -- | This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library.  module Ditto.Generalized.Internal where@@ -56,7 +49,7 @@         )  -- | this is necessary in order to basically map over the decoding function-inputList :: forall m input err a view view'. (Monad m, FormError input err, Environment m input)+inputList :: forall m input err a view view'. Environment m input   => FormState m FormId   -> (input -> m (Either err [a])) -- ^ decoding function for the list   -> ([view] -> view') -- ^ how to concatenate views@@ -111,7 +104,7 @@           )  -- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.-inputMaybe :: (Monad m, FormError input err, Environment m input)+inputMaybe :: Environment m input   => FormState m FormId   -> (input -> Either err a)   -> (FormId -> Maybe a -> view)@@ -166,19 +159,22 @@       )  -- | used for @\<input type=\"file\"\>@-inputFile :: forall m ft input err view. (Monad m, FormInput input, FormError input err, Environment m input, ft ~ FileType input, Monoid ft)+inputFile :: forall m ft input err view. (FormInput input, FormError input err, Environment m input, ft ~ FileType input, Monoid ft)   => FormState m FormId   -> (FormId -> view)   -> Form m input err view (FileType input) inputFile i' toView =-  Form (pure . getInputFile) (pure mempty) $ do -- FIXME+  Form (pure . getInputFile) (pure mempty) $ do     i <- i'     v <- getFormInput' i     case v of       Default ->         pure           ( View $ const $ toView i-          , Error [(unitRange i, commonFormError (InputMissing i :: CommonFormError input) :: err)]+          , Ok Proved+              { pos = unitRange i+              , unProved = mempty+              }           )       Found x -> case getInputFile x of         Right a -> pure@@ -199,7 +195,7 @@           )  -- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes-inputMulti :: forall m input err view a lbl. (FormError input err, FormInput input, Environment m input, Eq a)+inputMulti :: forall m input err view a lbl. (Environment m input, Eq a)   => FormState m FormId   -> [(a, lbl)] -- ^ value, label, initially checked   -> (input -> Either err [a])@@ -257,7 +253,7 @@   }  -- | radio buttons, single @\<select\>@ boxes-inputChoice :: forall a m err input lbl view. (FormError input err, FormInput input, Monad m, Eq a, Monoid view, Environment m input)+inputChoice :: forall a m err input lbl view. (FormError input err, Eq a, Environment m input)   => FormState m FormId   -> (a -> Bool) -- ^ is default   -> NonEmpty (a, lbl) -- ^ value, label

@@ -1,8 +1,3 @@-{-# LANGUAGE -    ScopedTypeVariables-  , TypeFamilies-#-}- -- | This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library. -- -- For unnamed (enumerated) formlets, see @Ditto.Generalized.Unnamed@@@ -42,7 +37,7 @@ input name = G.input (getNamedFormId name)  -- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.-inputMaybe :: (Environment m input, FormError input err)+inputMaybe :: Environment m input   => Text   -> (input -> Either err a)   -> (FormId -> Maybe a -> view)@@ -65,7 +60,7 @@ inputFile name = G.inputFile (getNamedFormId name)  -- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes-inputMulti :: forall m input err view a lbl. (FormError input err, FormInput input, Environment m input, Eq a)+inputMulti :: forall m input err view a lbl. (Environment m input, Eq a)   => Text   -> [(a, lbl)] -- ^ value, label, initially checked   -> (input -> Either err [a])@@ -75,7 +70,7 @@ inputMulti name = G.inputMulti (getNamedFormId name)  -- | radio buttons, single @\<select\>@ boxes-inputChoice :: forall a m err input lbl view. (FormError input err, FormInput input, Environment m input, Eq a, Monoid view)+inputChoice :: forall a m err input lbl view. (FormError input err, Environment m input, Eq a)   => Text   -> (a -> Bool) -- ^ is default   -> NonEmpty (a, lbl) -- ^ value, label@@ -85,7 +80,7 @@ inputChoice name = G.inputChoice (getNamedFormId name)  -- | this is necessary in order to basically map over the decoding function-inputList :: forall m input err a view. (Monad m, FormError input err, Environment m input)+inputList :: forall m input err a view. Environment m input   => Text   -> (input -> m (Either err [a])) -- ^ decoding function for the list   -> ([view] -> view) -- ^ how to concatenate views@@ -160,7 +155,7 @@       )  -- | an optional @Form@ with no @view@-iopt :: forall m input view err a. (Monoid view, Environment m input, FormError input err)+iopt :: forall m input view err a. (Monoid view, Environment m input)   => Text    -> (input -> Either err a)   -> Maybe a

@@ -1,8 +1,3 @@-{-# LANGUAGE -    ScopedTypeVariables-  , TypeFamilies-#-}- -- | This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library. -- -- Additionally, the inputs generated with the functions from this module will have their names/ids automatically enumerated.@@ -39,7 +34,7 @@ input = G.input getFormId  -- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.-inputMaybe :: (Environment m input, FormError input err)+inputMaybe :: Environment m input   => (input -> Either err a)   -> (FormId -> Maybe a -> view)   -> Maybe a@@ -59,7 +54,7 @@ inputFile = G.inputFile getFormId  -- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes-inputMulti :: forall m input err view a lbl. (FormError input err, FormInput input, Environment m input, Eq a)+inputMulti :: forall m input err view a lbl. (Environment m input, Eq a)   => [(a, lbl)] -- ^ value, label, initially checked   -> (input -> Either err [a])   -> (FormId -> [G.Choice lbl a] -> view) -- ^ function which generates the view@@ -68,7 +63,7 @@ inputMulti = G.inputMulti getFormId  -- | radio buttons, single @\<select\>@ boxes-inputChoice :: forall a m err input lbl view. (FormError input err, FormInput input, Environment m input, Eq a, Monoid view)+inputChoice :: forall a m err input lbl view. (FormError input err, Environment m input, Eq a)   => (a -> Bool) -- ^ is default   -> NonEmpty (a, lbl) -- ^ value, label   -> (input -> Either err a)@@ -77,7 +72,7 @@ inputChoice = G.inputChoice getFormId  -- | this is necessary in order to basically map over the decoding function-inputList :: forall m input err a view. (Monad m, FormError input err, Environment m input)+inputList :: forall m input err a view. Environment m input   => (input -> m (Either err [a])) -- ^ decoding function for the list   -> ([view] -> view) -- ^ how to concatenate views   -> [a] -- ^ initial values

@@ -1,9 +1,3 @@-{-# LANGUAGE-    DeriveFunctor-  , NamedFieldPuns-  , ScopedTypeVariables-#-}- {- | This module defines the 'Proof' type, some proofs, and some helper functions. @@ -18,7 +12,6 @@  import Control.Monad.Trans (lift) import Ditto.Core (Form(..))-import Ditto.Backend (FormError(..)) import Ditto.Types (Proved(..), Result(..)) import Numeric (readDec, readFloat, readSigned) @@ -34,11 +27,11 @@ data Proof m err a b = Proof   { proofFunction :: a -> m (Either err b) -- ^ function which provides the proof   , proofNewInitialValue :: a -> b -- ^ usually @const b@-  } deriving (Functor)+  } deriving stock (Functor)  -- | apply a 'Proof' to a 'Form' prove-  :: (Monad m, Monoid view, FormError input error)+  :: Monad m   => Form m input error view a   -> Proof m error a b   -> Form m input error view b@@ -69,7 +62,7 @@  -- | transform the 'Form' result using a monadic 'Either' function. transformEitherM-  :: (Monad m, Monoid view, FormError input error)+  :: Monad m   => Form m input error view a   -> (a -> m (Either error b))   -> (a -> b)@@ -78,7 +71,7 @@  -- | transform the 'Form' result using an 'Either' function. transformEither-  :: (Monad m, Monoid view, FormError input error)+  :: Monad m   => Form m input error view a   -> (a -> Either error b)   -> (a -> b)@@ -110,7 +103,7 @@         _ -> Left $ mkError str  -- | read signed decimal number-signedDecimal :: (Monad m, Eq i, Real i)+signedDecimal :: (Monad m, Real i)   => (String -> error)   -> i   -> Proof m error String i

@@ -1,15 +1,3 @@-{-# LANGUAGE-    BangPatterns-  , DeriveFoldable-  , DeriveFunctor-  , DeriveTraversable-  , GeneralizedNewtypeDeriving-  , MultiParamTypeClasses-  , OverloadedStrings-  , PatternSynonyms-  , ExplicitForAll-#-}- -- | Types relevant to forms and their validation. module Ditto.Types (   -- * FormId@@ -43,7 +31,7 @@   | FormIdName       {-# UNPACK #-} !Text -- ^ Local name of the input       {-# UNPACK #-} !Int  -- ^ Index of the input-  deriving (Eq, Ord, Show)+  deriving stock (Eq, Ord, Show)  instance IsString FormId where   fromString x = FormIdName (T.pack x) 0@@ -64,7 +52,7 @@ -- | A range of ID's to specify a group of forms data FormRange   = FormRange FormId FormId-  deriving (Eq, Show)+  deriving stock (Eq, Show)  ------------------------------------------------------------------------------ -- Form result types@@ -74,7 +62,7 @@  -- | Function which creates the form view newtype View err v = View { unView :: [(FormRange, err)] -> v }-  deriving (Semigroup, Monoid, Functor)+  deriving newtype (Semigroup, Monoid, Functor)  -- | used to represent whether a value was found in the form -- submission data, missing from the form submission data, or expected@@ -83,7 +71,7 @@   = Default   | Missing   | Found a-  deriving (Eq, Show, Functor, Traversable, Foldable)+  deriving stock (Eq, Show, Functor, Foldable, Traversable)  instance Applicative Value where   pure = Found@@ -111,7 +99,8 @@ -- | Type for failing computations -- Similar to @Either@ but with an accumilating @Applicative@ instance newtype Result e ok = Result { getResult :: Either [(FormRange, e)] ok }-  deriving (Show, Eq, Functor, Foldable, Traversable, Monad)+  deriving newtype (Eq, Show, Functor, Foldable, Monad)+  deriving stock (Traversable)  pattern Error :: forall e ok. [(FormRange, e)] -> Result e ok pattern Error e = Result (Left e)@@ -130,4 +119,4 @@ data Proved a = Proved   { pos :: FormRange   , unProved :: a-  } deriving (Show, Functor, Foldable, Traversable)+  } deriving stock (Show, Functor, Foldable, Traversable)

@@ -0,0 +1,294 @@+module Main (main) where++import Control.Applicative ((<|>))+import Control.Monad (unless)+import Control.Monad.Reader (runReaderT)+import Data.Functor.Identity (Identity, runIdentity)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Ditto+import Ditto.Generalized.Named qualified as Named+import Ditto.Generalized.Unnamed qualified as Unnamed+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import Text.Read (readMaybe)++import Data.Text qualified as T++-- | Minimal backend input type for file-upload tests.+newtype TestInput = TestInput Text+  deriving stock (Show)+  deriving newtype (Eq)++instance FormInput TestInput where+  type FileType TestInput = Text+  getInputTexts (TestInput t) = [t]+  getInputFile (TestInput t) = Right t++instance FormError TestInput Text where+  commonFormError = commonFormErrorText (T.pack . show)++main :: IO ()+main = do+  testEncodeFormId+  testResultApplicative+  testValueInstances+  testViewForm+  testNamedInput+  testUnnamedInput+  testIreqIopt+  testProofs+  testProofDecode+  testHoistForm+  testAlternative+  testCatchFormError+  testInputMulti+  testInputChoice+  testInputFile+  putStrLn "OK"++assertEq :: (Eq a, Show a) => String -> a -> a -> IO ()+assertEq label expected actual =+  unless (expected == actual) $ do+    hPutStrLn stderr $ "FAIL: " <> label+    hPutStrLn stderr $ "  expected: " <> show expected+    hPutStrLn stderr $ "  got:      " <> show actual+    exitFailure++testEncodeFormId :: IO ()+testEncodeFormId = do+  assertEq "encodeFormId numbered"+    "user-val-0.1.2"+    (encodeFormId (FormId "user" (0 :| [1, 2])))+  assertEq "encodeFormId named"+    "email"+    (encodeFormId (FormIdName "email" 3))+  assertEq "formIdentifier numbered" 0 (formIdentifier (FormId "user" (0 :| [1])))+  assertEq "formIdentifier named" 3 (formIdentifier (FormIdName "email" 3))++range0 :: FormRange+range0 = FormRange (FormIdName "a" 0) (FormIdName "a" 1)++testResultApplicative :: IO ()+testResultApplicative = do+  assertEq "Result accumulates errors"+    (Error [(range0, "a" :: Text), (range0, "b")] :: Result Text Int)+    (Error [(range0, "a")] <*> Error [(range0, "b")])+  assertEq "Result Ok <*> Ok"+    (Ok (3 :: Int) :: Result Text Int)+    (Ok (+ 1) <*> Ok (2 :: Int))++testValueInstances :: IO ()+testValueInstances = do+  assertEq "Found <*> Found" (Found (3 :: Int)) (Found (+ 1) <*> Found (2 :: Int))+  assertEq "Missing <|> Found" (Found (1 :: Int)) (Missing <|> Found 1)+  assertEq "Found <> Found" (Found ("ab" :: Text)) (Found "a" <> Found "b")++testViewForm :: IO ()+testViewForm = do+  let html = runIdentity $ viewForm "f" (view ("hello" :: Text))+  assertEq "viewForm renders defaults" ("hello" :: Text) html++evalForm+  :: [(Text, Text)]+  -> Form (WithEnvironment Text Identity) Text Text view a+  -> Either view a+evalForm pairs form =+  runIdentity $ flip runReaderT lookupFn $ getWithEnvironment $ eitherForm "f" form+  where+    lookupFn fid = pure $ maybe Missing Found (lookup (encodeFormId fid) pairs)++evalFormTest+  :: [(Text, TestInput)]+  -> Form (WithEnvironment TestInput Identity) TestInput Text view a+  -> Either view a+evalFormTest pairs form =+  runIdentity $ flip runReaderT lookupFn $ getWithEnvironment $ eitherForm "f" form+  where+    lookupFn fid = pure $ maybe Missing Found (lookup (encodeFormId fid) pairs)++evalFormDefault+  :: Form (WithEnvironment Text Identity) Text Text view a+  -> Either view a+evalFormDefault form =+  runIdentity $ flip runReaderT (const (pure Default)) $ getWithEnvironment $ eitherForm "f" form++evalFormTestDefault+  :: Form (WithEnvironment TestInput Identity) TestInput Text view a+  -> Either view a+evalFormTestDefault form =+  runIdentity $ flip runReaderT (const (pure Default)) $ getWithEnvironment $ eitherForm "f" form++decodeSubmitted+  :: Text+  -> Form (WithEnvironment Text Identity) Text Text view a+  -> Either Text a+decodeSubmitted raw form =+  runIdentity $+    runReaderT+      (getWithEnvironment (formDecodeInput form raw))+      (const (pure (Found raw)))++textField+  :: Text+  -> Text+  -> Form (WithEnvironment Text Identity) Text Text Text Text+textField name initial =+  Named.input name Right (\_fid val -> val) initial++testNamedInput :: IO ()+testNamedInput = do+  let form = (,) <$> textField "first" "a" <*> textField "last" "b"+  assertEq "named input reads environment"+    (Right ("Ada", "Lovelace") :: Either Text (Text, Text))+    (evalForm [("first", "Ada"), ("last", "Lovelace")] form)+  assertEq "named input uses defaults when missing"+    (Left "ab" :: Either Text (Text, Text))+    (evalForm [] form)++unnamedText+  :: Text+  -> Form (WithEnvironment Text Identity) Text Text Text Text+unnamedText initial =+  Unnamed.input Right (\_fid val -> val) initial++testUnnamedInput :: IO ()+testUnnamedInput = do+  let form = (,) <$> unnamedText "a" <*> unnamedText "b"+  assertEq "unnamed input enumerates ids"+    (Right ("Ada", "Lovelace") :: Either Text (Text, Text))+    (evalForm [("f-val-0", "Ada"), ("f-val-1", "Lovelace")] form)++readInt :: Text -> Either Text Int+readInt t = maybe (Left "not an int") Right (readMaybe (T.unpack t))++testIreqIopt :: IO ()+testIreqIopt = do+  assertEq "ireq success"+    (Right (42 :: Int) :: Either Text Int)+    (evalForm [("age", "42")] (Named.ireq "age" readInt 0))+  assertEq "ireq missing"+    (Left (mempty :: Text) :: Either Text Int)+    (evalForm [] (Named.ireq "age" readInt 0))+  assertEq "iopt missing is Nothing"+    (Right Nothing :: Either Text (Maybe Int))+    (evalForm [] (Named.iopt "age" readInt Nothing))+  assertEq "iopt found"+    (Right (Just (7 :: Int)) :: Either Text (Maybe Int))+    (evalForm [("age", "7")] (Named.iopt "age" readInt Nothing))++testProofs :: IO ()+testProofs = do+  let parsed =+        transformEither+          (pure "12" :: Form Identity Text Text Text String)+          (\s -> if s == "12" then Right (12 :: Int) else Left ("bad" :: Text))+          (const 0)+  assertEq "transformEither success"+    (Right (12 :: Int))+    (runIdentity $ eitherForm "f" parsed)+  let dec = prove (pure "42" :: Form Identity Text Text Text String) (decimal T.pack 0)+  assertEq "decimal proof"+    (Right (42 :: Int))+    (runIdentity $ eitherForm "f" dec)+  let nonempty = prove (pure [1, 2 :: Int] :: Form Identity Text Text Text [Int]) (notNullProof ("empty" :: Text))+  assertEq "notNullProof"+    (Right [1, 2 :: Int])+    (runIdentity $ eitherForm "f" nonempty)++testProofDecode :: IO ()+testProofDecode = do+  let decoded = transformEither (textField "amount" "0") readInt (const 0)+  assertEq "prove decode valid"+    (Right (7 :: Int))+    (decodeSubmitted "7" decoded)+  assertEq "prove decode invalid"+    (Left ("not an int" :: Text))+    (decodeSubmitted "nope" decoded)+  assertEq "prove submit valid"+    (Right (9 :: Int))+    (evalForm [("amount", "9")] decoded)++pickLabels :: FormId -> [Named.Choice Text Text] -> Text+pickLabels _ = T.intercalate "," . map Named.choiceLabel++testHoistForm :: IO ()+testHoistForm = do+  let inner = view ("ok" :: Text) :: Form Identity Text Text Text ()+      outer = hoistForm id inner+  assertEq "hoistForm Identity"+    ("ok" :: Text)+    (runIdentity $ viewForm "f" outer)++testAlternative :: IO ()+testAlternative = do+  let failing = Named.ireq "x" readInt 0 :: Form (WithEnvironment Text Identity) Text Text Text Int+      fallback = pure (99 :: Int) :: Form (WithEnvironment Text Identity) Text Text Text Int+      combined = failing <|> fallback+  assertEq "Alternative fallback"+    (Right (99 :: Int))+    (evalForm [] combined)++testCatchFormError :: IO ()+testCatchFormError = do+  let form =+        catchFormError+          (const (0 :: Int))+          (Named.ireq "x" readInt 999 :: Form (WithEnvironment Text Identity) Text Text Text Int)+  assertEq "catchFormError recovery"+    (Right (0 :: Int))+    (evalForm [] form)++parseTags :: Text -> Either Text [Text]+parseTags inp = Right (T.words inp)++testInputMulti :: IO ()+testInputMulti = do+  let form =+        Named.inputMulti+          "tags"+          [("a", "alpha"), ("b", "beta")]+          parseTags+          pickLabels+          (== "a")+  assertEq "inputMulti default selection"+    (Right ["a"] :: Either Text [Text])+    (evalFormDefault form)+  assertEq "inputMulti submitted values"+    (Right ["b"] :: Either Text [Text])+    (evalForm [("tags", "b")] form)+  assertEq "inputMulti multiple submitted values"+    (Right ["a", "b"] :: Either Text [Text])+    (evalForm [("tags", "a b")] form)++testInputChoice :: IO ()+testInputChoice = do+  let form =+        Named.inputChoice+          "mode"+          (== "b")+          (("a", "A") :| [("b", "B")])+          (\inp -> Right inp)+          pickLabels+  assertEq "inputChoice default"+    (Right ("b" :: Text))+    (evalForm [] form)+  assertEq "inputChoice submitted"+    (Right ("a" :: Text))+    (evalForm [("mode", "a")] form)++testInputFile :: IO ()+testInputFile = do+  let form = Named.inputFile "upload" (\_ -> "widget" :: Text)+  assertEq "inputFile initial render"+    (Right (mempty :: Text))+    (evalFormTestDefault form)+  assertEq "inputFile missing on submit"+    (Left ("widget" :: Text))+    (evalFormTest [] form)+  assertEq "inputFile submitted"+    (Right ("payload" :: Text))+    (evalFormTest [("upload", TestInput "payload")] form)+  assertEq "inputFile decode"+    (Right ("payload" :: Text))+    (runIdentity $ runReaderT (getWithEnvironment (formDecodeInput form (TestInput "payload"))) (const (pure Default)))