{-# LANGUAGE ScopedTypeVariables, TypeFamilies, ViewPatterns #-}
{- |
This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library.
-}
module Text.Reform.Generalized where

import Control.Applicative    ((<$>))
import Control.Monad          (foldM)
import Control.Monad.Trans    (lift)
import qualified Data.IntSet  as IS
import Data.List              (find)
import Data.Maybe             (mapMaybe)
import Numeric                (readDec)
import Text.Reform.Backend
import Text.Reform.Core
import Text.Reform.Result

-- | used for constructing elements like @\<input type=\"text\"\>@, which return a single input value.
input :: (Monad m, FormError error) =>
         (input -> Either error a)
      -> (FormId -> a -> view)
      -> a
      -> Form m input error view () a
input :: (input -> Either error a)
-> (FormId -> a -> view) -> a -> Form m input error view () a
input input -> Either error a
fromInput FormId -> a -> view
toView a
initialValue =
    FormState m input (View error view, m (Result error (Proved () a)))
-> Form m input error view () a
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () a)))
 -> Form m input error view () a)
-> FormState
     m input (View error view, m (Result error (Proved () a)))
-> Form m input error view () a
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              Value input
v <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i
              case Value input
v of
                Value input
Default ->
                    (View error view, m (Result error (Proved () a)))
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ Proved () a -> Result error (Proved () a)
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: a
unProved = a
initialValue
                                                 }))
                (Found (input -> Either error a
fromInput -> (Right a
a))) ->
                    (View error view, m (Result error (Proved () a)))
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
a
                           , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ Proved () a -> Result error (Proved () a)
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: a
unProved = a
a
                                                 }))
                (Found (input -> Either error a
fromInput -> (Left error
error))) ->
                    (View error view, m (Result error (Proved () a)))
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, error
error)]
                           )
                Value input
Missing ->
                    (View error view, m (Result error (Proved () a)))
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (FormId -> CommonFormError (ErrorInputType error)
forall input. FormId -> CommonFormError input
InputMissing FormId
i))]
                           )

-- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.
inputMaybe :: (Monad m, FormError error) =>
         (input -> Either error a)
      -> (FormId -> a -> view)
      -> a
      -> Form m input error view () (Maybe a)
inputMaybe :: (input -> Either error a)
-> (FormId -> a -> view)
-> a
-> Form m input error view () (Maybe a)
inputMaybe input -> Either error a
fromInput FormId -> a -> view
toView a
initialValue =
    FormState
  m input (View error view, m (Result error (Proved () (Maybe a))))
-> Form m input error view () (Maybe a)
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () (Maybe a))))
 -> Form m input error view () (Maybe a))
-> FormState
     m input (View error view, m (Result error (Proved () (Maybe a))))
-> Form m input error view () (Maybe a)
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              Value input
v <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i
              case Value input
v of
                Value input
Default ->
                    (View error view, m (Result error (Proved () (Maybe a))))
-> FormState
     m input (View error view, m (Result error (Proved () (Maybe a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (Maybe a))
 -> m (Result error (Proved () (Maybe a))))
-> Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall a b. (a -> b) -> a -> b
$ Proved () (Maybe a) -> Result error (Proved () (Maybe a))
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: Maybe a
unProved = a -> Maybe a
forall a. a -> Maybe a
Just a
initialValue
                                                 }))
                (Found (input -> Either error a
fromInput -> (Right a
a))) ->
                    (View error view, m (Result error (Proved () (Maybe a))))
-> FormState
     m input (View error view, m (Result error (Proved () (Maybe a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
a
                           , Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (Maybe a))
 -> m (Result error (Proved () (Maybe a))))
-> Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall a b. (a -> b) -> a -> b
$ Proved () (Maybe a) -> Result error (Proved () (Maybe a))
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: Maybe a
unProved = (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                                                 }))
                (Found (input -> Either error a
fromInput -> (Left error
error))) ->
                    (View error view, m (Result error (Proved () (Maybe a))))
-> FormState
     m input (View error view, m (Result error (Proved () (Maybe a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (Maybe a))
 -> m (Result error (Proved () (Maybe a))))
-> Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () (Maybe a))
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, error
error)]
                           )
                Value input
Missing ->
                    (View error view, m (Result error (Proved () (Maybe a))))
-> FormState
     m input (View error view, m (Result error (Proved () (Maybe a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
initialValue
                           , Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (Maybe a))
 -> m (Result error (Proved () (Maybe a))))
-> Result error (Proved () (Maybe a))
-> m (Result error (Proved () (Maybe a)))
forall a b. (a -> b) -> a -> b
$ Proved () (Maybe a) -> Result error (Proved () (Maybe a))
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: Maybe a
unProved = Maybe a
forall a. Maybe a
Nothing
                                                 })
                           )

-- | used for elements like @\<input type=\"reset\"\>@ which take a value, but are never present in the form data set.
inputNoData :: (Monad m) =>
              (FormId -> a -> view)
           -> a
           -> Form m input error view () ()
inputNoData :: (FormId -> a -> view) -> a -> Form m input error view () ()
inputNoData FormId -> a -> view
toView a
a =
    FormState
  m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () ())))
 -> Form m input error view () ())
-> FormState
     m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              (View error view, m (Result error (Proved () ())))
-> FormState
     m input (View error view, m (Result error (Proved () ())))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> a -> view
toView FormId
i a
a
                     , Result error (Proved () ()) -> m (Result error (Proved () ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () ()) -> m (Result error (Proved () ())))
-> Result error (Proved () ()) -> m (Result error (Proved () ()))
forall a b. (a -> b) -> a -> b
$ Proved () () -> Result error (Proved () ())
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                           , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                           , unProved :: ()
unProved = ()
                                           })
                     )

-- | used for @\<input type=\"file\"\>@
inputFile :: forall m input error view. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>
             (FormId -> view)
          -> Form m input error view () (FileType input)
inputFile :: (FormId -> view) -> Form m input error view () (FileType input)
inputFile FormId -> view
toView =
    FormState
  m
  input
  (View error view, m (Result error (Proved () (FileType input))))
-> Form m input error view () (FileType input)
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m
   input
   (View error view, m (Result error (Proved () (FileType input))))
 -> Form m input error view () (FileType input))
-> FormState
     m
     input
     (View error view, m (Result error (Proved () (FileType input))))
-> Form m input error view () (FileType input)
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              Value input
v <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i
              case Value input
v of
                Value input
Default ->
                    (View error view, m (Result error (Proved () (FileType input))))
-> FormState
     m
     input
     (View error view, m (Result error (Proved () (FileType input))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> view
toView FormId
i
                           , Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (FileType input))
 -> m (Result error (Proved () (FileType input))))
-> Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () (FileType input))
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (FormId -> CommonFormError input
forall input. FormId -> CommonFormError input
InputMissing FormId
i))]
                           )

                (Found (input -> Either error (FileType input)
(FormError error, ErrorInputType error ~ input) =>
input -> Either error (FileType input)
getInputFile' -> (Right FileType input
a))) ->
                    (View error view, m (Result error (Proved () (FileType input))))
-> FormState
     m
     input
     (View error view, m (Result error (Proved () (FileType input))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> view
toView FormId
i
                           , Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (FileType input))
 -> m (Result error (Proved () (FileType input))))
-> Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall a b. (a -> b) -> a -> b
$ Proved () (FileType input)
-> Result error (Proved () (FileType input))
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                                 , unProved :: FileType input
unProved = FileType input
a
                                                 }))

                (Found (input -> Either error (FileType input)
(FormError error, ErrorInputType error ~ input) =>
input -> Either error (FileType input)
getInputFile' -> (Left error
error))) ->
                    (View error view, m (Result error (Proved () (FileType input))))
-> FormState
     m
     input
     (View error view, m (Result error (Proved () (FileType input))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> view
toView FormId
i
                           , Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (FileType input))
 -> m (Result error (Proved () (FileType input))))
-> Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () (FileType input))
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, error
error)]
                           )
                Value input
Missing ->
                    (View error view, m (Result error (Proved () (FileType input))))
-> FormState
     m
     input
     (View error view, m (Result error (Proved () (FileType input))))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> view
toView FormId
i
                           , Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () (FileType input))
 -> m (Result error (Proved () (FileType input))))
-> Result error (Proved () (FileType input))
-> m (Result error (Proved () (FileType input)))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () (FileType input))
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (FormId -> CommonFormError input
forall input. FormId -> CommonFormError input
InputMissing FormId
i))]
                           )
        where
          -- just here for the type-signature to make the type-checker happy
          getInputFile' :: (FormError error, ErrorInputType error ~ input) => input -> Either error (FileType input)
          getInputFile' :: input -> Either error (FileType input)
getInputFile' = input -> Either error (FileType input)
forall input error.
(FormInput input, FormError error, ErrorInputType error ~ input) =>
input -> Either error (FileType input)
getInputFile

-- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes
inputMulti :: forall m input error view a lbl. (Functor m, FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
              [(a, lbl)]                                      -- ^ value, label, initially checked
           -> (FormId -> [(FormId, Int, lbl, Bool)] -> view)  -- ^ function which generates the view
           -> (a -> Bool)                                     -- ^ isChecked/isSelected initially
           -> Form m input error view () [a]
inputMulti :: [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> (a -> Bool)
-> Form m input error view () [a]
inputMulti [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView a -> Bool
isSelected =
    FormState
  m input (View error view, m (Result error (Proved () [a])))
-> Form m input error view () [a]
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () [a])))
 -> Form m input error view () [a])
-> FormState
     m input (View error view, m (Result error (Proved () [a])))
-> Form m input error view () [a]
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              Value input
inp <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i
              case Value input
inp of

                Value input
Default ->
                    do let ([(a, lbl, Bool)]
choices', [a]
vals) = ((a, lbl) -> ([(a, lbl, Bool)], [a]) -> ([(a, lbl, Bool)], [a]))
-> ([(a, lbl, Bool)], [a]) -> [(a, lbl)] -> ([(a, lbl, Bool)], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a, lbl
lbl) ([(a, lbl, Bool)]
cs,[a]
vs) ->
                                                         if a -> Bool
isSelected a
a
                                                         then ((a
a, lbl
lbl, Bool
True) (a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
:[(a, lbl, Bool)]
cs, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs)
                                                         else ((a
a, lbl
lbl, Bool
False)(a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
:[(a, lbl, Bool)]
cs,   [a]
vs))
                                                    ([],[])
                                                    [(a, lbl)]
choices
                       view
view     <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices'
                       FormId
-> view
-> [a]
-> FormState
     m input (View error view, m (Result error (Proved () [a])))
forall (m :: * -> *) view a input error.
Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i view
view [a]
vals

                Value input
Missing -> -- just means that no checkboxes were checked
                     do view
view <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices (((a, lbl) -> (a, lbl, Bool)) -> [(a, lbl)] -> [(a, lbl, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
x,lbl
y) -> (a
x,lbl
y,Bool
False)) [(a, lbl)]
choices)
                        FormId
-> view
-> [a]
-> FormState
     m input (View error view, m (Result error (Proved () [a])))
forall (m :: * -> *) view a input error.
Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i view
view []

                (Found input
v) ->
                    do let readDec' :: String -> p
readDec' String
str = case ReadS p
forall a. (Eq a, Num a) => ReadS a
readDec String
str of
                                            [(p
n,[])] -> p
n
                                            [(p, String)]
_ -> (-p
1) -- FIXME: should probably return an internal error?
                           keys :: IntSet
keys   = [Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall p. (Eq p, Num p) => String -> p
readDec' ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ input -> [String]
forall input. FormInput input => input -> [String]
getInputStrings input
v
                           ([(a, lbl, Bool)]
choices', [a]
vals) =
                               ((Int, (a, lbl))
 -> ([(a, lbl, Bool)], [a]) -> ([(a, lbl, Bool)], [a]))
-> ([(a, lbl, Bool)], [a])
-> [(Int, (a, lbl))]
-> ([(a, lbl, Bool)], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, (a
a,lbl
lbl)) ([(a, lbl, Bool)]
c,[a]
v) ->
                                          if Int -> IntSet -> Bool
IS.member Int
i IntSet
keys
                                          then ((a
a,lbl
lbl,Bool
True) (a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(a, lbl, Bool)]
c, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
v)
                                          else ((a
a,lbl
lbl,Bool
False)(a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(a, lbl, Bool)]
c,     [a]
v)) ([],[]) ([(Int, (a, lbl))] -> ([(a, lbl, Bool)], [a]))
-> [(Int, (a, lbl))] -> ([(a, lbl, Bool)], [a])
forall a b. (a -> b) -> a -> b
$
                                 [Int] -> [(a, lbl)] -> [(Int, (a, lbl))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(a, lbl)]
choices
                       view
view <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices'
                       FormId
-> view
-> [a]
-> FormState
     m input (View error view, m (Result error (Proved () [a])))
forall (m :: * -> *) view a input error.
Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i view
view [a]
vals


    where
      augmentChoices :: (Monad m) => [(a, lbl, Bool)] -> FormState m input [(FormId, Int, lbl, Bool)]
      augmentChoices :: [(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices = ((Int, (a, lbl, Bool))
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (FormId, Int, lbl, Bool))
-> [(Int, (a, lbl, Bool))]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Monad m =>
(Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
(Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
augmentChoice ([Int] -> [(a, lbl, Bool)] -> [(Int, (a, lbl, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(a, lbl, Bool)]
choices)

      augmentChoice :: (Monad m) => (Int, (a, lbl, Bool)) -> FormState m input (FormId, Int, lbl, Bool)
      augmentChoice :: (Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
augmentChoice (Int
vl, (a
a, lbl
lbl, Bool
checked)) =
          do FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
             FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
             (FormId, Int, lbl, Bool)
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormId
i, Int
vl, lbl
lbl, Bool
checked)


-- | radio buttons, single @\<select\>@ boxes
inputChoice :: forall a m error input lbl view. (Functor m, FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
               (a -> Bool)                                     -- ^ is default
            -> [(a, lbl)]                                      -- ^ value, label
            -> (FormId -> [(FormId, Int, lbl, Bool)] -> view)  -- ^ function which generates the view
            -> Form m input error view () a
inputChoice :: (a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> Form m input error view () a
inputChoice a -> Bool
isDefault [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView =
    FormState m input (View error view, m (Result error (Proved () a)))
-> Form m input error view () a
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () a)))
 -> Form m input error view () a)
-> FormState
     m input (View error view, m (Result error (Proved () a)))
-> Form m input error view () a
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
              Value input
inp <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i

              case Value input
inp of
                Value input
Default ->
                    do let ([(a, lbl, Bool)]
choices', Maybe a
def) = [(a, lbl)] -> ([(a, lbl, Bool)], Maybe a)
markSelected [(a, lbl)]
choices
                       view
view <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices'
                       FormId
-> view
-> Maybe a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) error v a input.
(Monad m, FormError error) =>
FormId
-> v
-> Maybe a
-> FormState m input (View error v, m (Result error (Proved () a)))
mkOk' FormId
i view
view Maybe a
def

                Value input
Missing -> -- can happen if no choices where checked
                    do let ([(a, lbl, Bool)]
choices', Maybe a
def) = [(a, lbl)] -> ([(a, lbl, Bool)], Maybe a)
markSelected [(a, lbl)]
choices
                       view
view <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices'
                       FormId
-> view
-> Maybe a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) error v a input.
(Monad m, FormError error) =>
FormId
-> v
-> Maybe a
-> FormState m input (View error v, m (Result error (Proved () a)))
mkOk' FormId
i view
view Maybe a
def

                (Found input
v) ->
                    do let readDec' :: String -> Int
                           readDec' :: String -> Int
readDec' String
str = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
readDec String
str of
                                            [(Int
n,[])] -> Int
n
                                            [(Int, String)]
_ -> (-Int
1) -- FIXME: should probably return an internal error?
                           (Right String
str) = input -> Either error String
forall input error.
(FormInput input, FormError error, ErrorInputType error ~ input) =>
input -> Either error String
getInputString input
v :: Either error String -- FIXME
                           key :: Int
key = String -> Int
readDec' String
str
                           ([(a, lbl, Bool)]
choices', Maybe a
mval) =
                               ((Int, (a, lbl))
 -> ([(a, lbl, Bool)], Maybe a) -> ([(a, lbl, Bool)], Maybe a))
-> ([(a, lbl, Bool)], Maybe a)
-> [(Int, (a, lbl))]
-> ([(a, lbl, Bool)], Maybe a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, (a
a, lbl
lbl)) ([(a, lbl, Bool)]
c, Maybe a
v) ->
                                          if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
key
                                          then ((a
a,lbl
lbl,Bool
True) (a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(a, lbl, Bool)]
c, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                                          else ((a
a,lbl
lbl,Bool
False)(a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(a, lbl, Bool)]
c,     Maybe a
v))
                                     ([], Maybe a
forall a. Maybe a
Nothing) ([(Int, (a, lbl))] -> ([(a, lbl, Bool)], Maybe a))
-> [(Int, (a, lbl))] -> ([(a, lbl, Bool)], Maybe a)
forall a b. (a -> b) -> a -> b
$
                                     [Int] -> [(a, lbl)] -> [(Int, (a, lbl))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(a, lbl)]
choices
                       view
view <- FormId -> [(FormId, Int, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, lbl, Bool)] -> view)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
-> ReaderT (Environment m input) (StateT FormRange m) view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monad m =>
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
[(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices'
                       case Maybe a
mval of
                         Maybe a
Nothing ->
                             (View error view, m (Result error (Proved () a)))
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ view
view
                                    , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (FormId -> CommonFormError input
forall input. FormId -> CommonFormError input
InputMissing FormId
i))]
                                    )
                         (Just a
val) -> FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
forall (m :: * -> *) view a input error.
Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i view
view a
val

    where
      mkOk' :: FormId
-> v
-> Maybe a
-> FormState m input (View error v, m (Result error (Proved () a)))
mkOk' FormId
i v
view (Just a
val) = FormId
-> v
-> a
-> FormState m input (View error v, m (Result error (Proved () a)))
forall (m :: * -> *) view a input error.
Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i v
view a
val
      mkOk' FormId
i v
view Maybe a
Nothing =
          (View error v, m (Result error (Proved () a)))
-> FormState m input (View error v, m (Result error (Proved () a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> v) -> View error v
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> v) -> View error v)
-> ([(FormRange, error)] -> v) -> View error v
forall a b. (a -> b) -> a -> b
$ v -> [(FormRange, error)] -> v
forall a b. a -> b -> a
const (v -> [(FormRange, error)] -> v) -> v -> [(FormRange, error)] -> v
forall a b. (a -> b) -> a -> b
$ v
view
                 , Result error (Proved () a) -> m (Result error (Proved () a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () a) -> m (Result error (Proved () a)))
-> Result error (Proved () a) -> m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError CommonFormError (ErrorInputType error)
forall input. CommonFormError input
MissingDefaultValue)]
                 )

      markSelected :: [(a,lbl)] -> ([(a, lbl, Bool)], Maybe a)
      markSelected :: [(a, lbl)] -> ([(a, lbl, Bool)], Maybe a)
markSelected [(a, lbl)]
cs = ((a, lbl)
 -> ([(a, lbl, Bool)], Maybe a) -> ([(a, lbl, Bool)], Maybe a))
-> ([(a, lbl, Bool)], Maybe a)
-> [(a, lbl)]
-> ([(a, lbl, Bool)], Maybe a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a,lbl
lbl) ([(a, lbl, Bool)]
vs, Maybe a
ma) ->
                                   if a -> Bool
isDefault a
a
                                      then ((a
a,lbl
lbl,Bool
True)(a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
:[(a, lbl, Bool)]
vs , a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                                      else ((a
a,lbl
lbl,Bool
False)(a, lbl, Bool) -> [(a, lbl, Bool)] -> [(a, lbl, Bool)]
forall a. a -> [a] -> [a]
:[(a, lbl, Bool)]
vs, Maybe a
ma))
                         ([], Maybe a
forall a. Maybe a
Nothing)
                         [(a, lbl)]
cs

      augmentChoices :: (Monad m) => [(a, lbl, Bool)] -> FormState m input [(FormId, Int, lbl, Bool)]
      augmentChoices :: [(a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
augmentChoices [(a, lbl, Bool)]
choices = ((Int, (a, lbl, Bool))
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (FormId, Int, lbl, Bool))
-> [(Int, (a, lbl, Bool))]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, lbl, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Monad m =>
(Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
(Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
augmentChoice ([Int] -> [(a, lbl, Bool)] -> [(Int, (a, lbl, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(a, lbl, Bool)]
choices)

      augmentChoice :: (Monad m) => (Int, (a, lbl, Bool)) -> FormState m input (FormId, Int, lbl, Bool)
      augmentChoice :: (Int, (a, lbl, Bool))
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
augmentChoice (Int
vl, (a
_a, lbl
lbl,Bool
selected)) =
          do FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
             FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
             (FormId, Int, lbl, Bool)
-> ReaderT
     (Environment m input) (StateT FormRange m) (FormId, Int, lbl, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormId
i, Int
vl, lbl
lbl, Bool
selected)


-- | radio buttons, single @\<select\>@ boxes
inputChoiceForms :: forall a m error input lbl view proof. (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input) =>
                    a
                 -> [(Form m input error view proof a, lbl)]           -- ^ value, label
                 -> (FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view)  -- ^ function which generates the view
                 -> Form m input error view proof a
inputChoiceForms :: a
-> [(Form m input error view proof a, lbl)]
-> (FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view)
-> Form m input error view proof a
inputChoiceForms a
def [(Form m input error view proof a, lbl)]
choices FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view
mkView =
    FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved proof a)))
 -> Form m input error view proof a)
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
forall a b. (a -> b) -> a -> b
$ do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId -- id used for the 'name' attribute of the radio buttons
              Value input
inp <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i

              case Value input
inp of
                Value input
Default -> -- produce view for GET request
                    do [(FormId, Int, FormId, view, lbl, Bool)]
choices' <- ((FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (FormId, Int, FormId, view, lbl, Bool))
-> [(FormId, Int, FormId, Form m input error view proof a, lbl,
     Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, view, lbl, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, view, lbl, Bool)
viewSubForm ([(FormId, Int, FormId, Form m input error view proof a, lbl,
   Bool)]
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      [(FormId, Int, FormId, view, lbl, Bool)])
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, view, lbl, Bool)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Monad m =>
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
augmentChoices ([(Form m input error view proof a, lbl)]
-> [(Form m input error view proof a, lbl, Bool)]
selectFirst [(Form m input error view proof a, lbl)]
choices)
                       let view :: view
view = FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view
mkView FormId
i [(FormId, Int, FormId, view, lbl, Bool)]
choices'
                       Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
mkOk' FormId
i view
view a
def

                Value input
Missing -> -- shouldn't ever happen...
                    do [(FormId, Int, FormId, view, lbl, Bool)]
choices' <- ((FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (FormId, Int, FormId, view, lbl, Bool))
-> [(FormId, Int, FormId, Form m input error view proof a, lbl,
     Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, view, lbl, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, view, lbl, Bool)
viewSubForm ([(FormId, Int, FormId, Form m input error view proof a, lbl,
   Bool)]
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      [(FormId, Int, FormId, view, lbl, Bool)])
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, view, lbl, Bool)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Monad m =>
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
augmentChoices ([(Form m input error view proof a, lbl)]
-> [(Form m input error view proof a, lbl, Bool)]
selectFirst [(Form m input error view proof a, lbl)]
choices)
                       let view :: view
view = FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view
mkView FormId
i [(FormId, Int, FormId, view, lbl, Bool)]
choices'
                       Monad m =>
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
mkOk' FormId
i view
view a
def

                (Found input
v) ->
                    do let readDec' :: String -> p
readDec' String
str = case ReadS p
forall a. (Eq a, Num a) => ReadS a
readDec String
str of
                                            [(p
n,[])] ->   p
n
                                            [(p, String)]
_        -> (-p
1) -- FIXME: should probably return an internal error?
                           (Right String
str) = input -> Either error String
forall input error.
(FormInput input, FormError error, ErrorInputType error ~ input) =>
input -> Either error String
getInputString input
v :: Either error String -- FIXME
                           key :: Int
key         = String -> Int
forall p. (Eq p, Num p) => String -> p
readDec' String
str
                       [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
choices'     <- Monad m =>
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
[(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
augmentChoices ([(Form m input error view proof a, lbl, Bool)]
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      [(FormId, Int, FormId, Form m input error view proof a, lbl,
        Bool)])
-> [(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, (Form m input error view proof a, lbl))]
-> [(Form m input error view proof a, lbl, Bool)]
markSelected Int
key ([Int]
-> [(Form m input error view proof a, lbl)]
-> [(Int, (Form m input error view proof a, lbl))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Form m input error view proof a, lbl)]
choices)

                       ([(FormId, Int, FormId, view, lbl, Bool)]
choices'', m (Result error (Proved proof a))
mres) <-
                           (([(FormId, Int, FormId, view, lbl, Bool)],
  m (Result error (Proved proof a)))
 -> (FormId, Int, FormId, Form m input error view proof a, lbl,
     Bool)
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      ([(FormId, Int, FormId, view, lbl, Bool)],
       m (Result error (Proved proof a))))
-> ([(FormId, Int, FormId, view, lbl, Bool)],
    m (Result error (Proved proof a)))
-> [(FormId, Int, FormId, Form m input error view proof a, lbl,
     Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     ([(FormId, Int, FormId, view, lbl, Bool)],
      m (Result error (Proved proof a)))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([(FormId, Int, FormId, view, lbl, Bool)]
views, m (Result error (Proved proof a))
res)  (FormId
fid, Int
val, FormId
iview, Form m input error view proof a
frm, lbl
lbl, Bool
selected) -> do
                                      FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
                                      if Bool
selected
                                         then do (View error view
v, m (Result error (Proved proof a))
mres) <- Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
unForm Form m input error view proof a
frm
                                                 Result error (Proved proof a)
res' <- StateT FormRange m (Result error (Proved proof a))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (Result error (Proved proof a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result error (Proved proof a))
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (Result error (Proved proof a)))
-> StateT FormRange m (Result error (Proved proof a))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (Result error (Proved proof a))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved proof a))
-> StateT FormRange m (Result error (Proved proof a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Result error (Proved proof a))
mres
                                                 case Result error (Proved proof a)
res' of
                                                   (Ok Proved proof a
ok) -> do
                                                       ([(FormId, Int, FormId, view, lbl, Bool)],
 m (Result error (Proved proof a)))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     ([(FormId, Int, FormId, view, lbl, Bool)],
      m (Result error (Proved proof a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (((FormId
fid, Int
val, FormId
iview, View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [], lbl
lbl, Bool
selected) (FormId, Int, FormId, view, lbl, Bool)
-> [(FormId, Int, FormId, view, lbl, Bool)]
-> [(FormId, Int, FormId, view, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(FormId, Int, FormId, view, lbl, Bool)]
views), Result error (Proved proof a) -> m (Result error (Proved proof a))
forall (m :: * -> *) a. Monad m => a -> m a
return Result error (Proved proof a)
res')
                                                   (Error [(FormRange, error)]
errs) -> do
                                                       ([(FormId, Int, FormId, view, lbl, Bool)],
 m (Result error (Proved proof a)))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     ([(FormId, Int, FormId, view, lbl, Bool)],
      m (Result error (Proved proof a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (((FormId
fid, Int
val, FormId
iview, View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [(FormRange, error)]
errs, lbl
lbl, Bool
selected) (FormId, Int, FormId, view, lbl, Bool)
-> [(FormId, Int, FormId, view, lbl, Bool)]
-> [(FormId, Int, FormId, view, lbl, Bool)]
forall a. a -> [a] -> [a]
: [(FormId, Int, FormId, view, lbl, Bool)]
views), Result error (Proved proof a) -> m (Result error (Proved proof a))
forall (m :: * -> *) a. Monad m => a -> m a
return Result error (Proved proof a)
res')
                                         else do (View error view
v, m (Result error (Proved proof a))
_) <- Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
unForm Form m input error view proof a
frm
                                                 ([(FormId, Int, FormId, view, lbl, Bool)],
 m (Result error (Proved proof a)))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     ([(FormId, Int, FormId, view, lbl, Bool)],
      m (Result error (Proved proof a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FormId
fid, Int
val, FormId
iview, View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [], lbl
lbl, Bool
selected)(FormId, Int, FormId, view, lbl, Bool)
-> [(FormId, Int, FormId, view, lbl, Bool)]
-> [(FormId, Int, FormId, view, lbl, Bool)]
forall a. a -> [a] -> [a]
:[(FormId, Int, FormId, view, lbl, Bool)]
views, m (Result error (Proved proof a))
res)
                                                                          ) ([], Result error (Proved proof a) -> m (Result error (Proved proof a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved proof a)
 -> m (Result error (Proved proof a)))
-> Result error (Proved proof a)
-> m (Result error (Proved proof a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved proof a)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormId -> FormRange
unitRange FormId
i, CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (FormId -> CommonFormError input
forall input. FormId -> CommonFormError input
InputMissing FormId
i))]) ([(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
choices')
                       let view :: view
view = FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view
mkView FormId
i ([(FormId, Int, FormId, view, lbl, Bool)]
-> [(FormId, Int, FormId, view, lbl, Bool)]
forall a. [a] -> [a]
reverse [(FormId, Int, FormId, view, lbl, Bool)]
choices'')
                       (View error view, m (Result error (Proved proof a)))
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const view
view), m (Result error (Proved proof a))
mres)

    where
      -- | Utility Function: turn a view and return value into a successful 'FormState'
      mkOk' :: (Monad m) =>
               FormId
            -> view
            -> a
            -> FormState m input (View error view, m (Result error (Proved proof a)))
      mkOk' :: FormId
-> view
-> a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
mkOk' FormId
i view
view a
val =
          (View error view, m (Result error (Proved proof a)))
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> view) -> View error view)
-> ([(FormRange, error)] -> view) -> View error view
forall a b. (a -> b) -> a -> b
$ view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ view
view
                 , Result error (Proved proof a) -> m (Result error (Proved proof a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved proof a)
 -> m (Result error (Proved proof a)))
-> Result error (Proved proof a)
-> m (Result error (Proved proof a))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved proof a)
forall e ok. [(FormRange, e)] -> Result e ok
Error []
                 )

      selectFirst :: [(Form m input error view proof a, lbl)] -> [(Form m input error view proof a, lbl, Bool)]
      selectFirst :: [(Form m input error view proof a, lbl)]
-> [(Form m input error view proof a, lbl, Bool)]
selectFirst ((Form m input error view proof a
frm, lbl
lbl):[(Form m input error view proof a, lbl)]
fs) = (Form m input error view proof a
frm,lbl
lbl,Bool
True) (Form m input error view proof a, lbl, Bool)
-> [(Form m input error view proof a, lbl, Bool)]
-> [(Form m input error view proof a, lbl, Bool)]
forall a. a -> [a] -> [a]
: ((Form m input error view proof a, lbl)
 -> (Form m input error view proof a, lbl, Bool))
-> [(Form m input error view proof a, lbl)]
-> [(Form m input error view proof a, lbl, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Form m input error view proof a
frm',lbl
lbl') -> (Form m input error view proof a
frm', lbl
lbl', Bool
False)) [(Form m input error view proof a, lbl)]
fs

      markSelected :: Int -> [(Int, (Form m input error view proof a, lbl))] -> [(Form m input error view proof a, lbl, Bool)]
      markSelected :: Int
-> [(Int, (Form m input error view proof a, lbl))]
-> [(Form m input error view proof a, lbl, Bool)]
markSelected Int
n [(Int, (Form m input error view proof a, lbl))]
choices =
          ((Int, (Form m input error view proof a, lbl))
 -> (Form m input error view proof a, lbl, Bool))
-> [(Int, (Form m input error view proof a, lbl))]
-> [(Form m input error view proof a, lbl, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Form m input error view proof a
f, lbl
lbl)) -> (Form m input error view proof a
f, lbl
lbl, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n)) [(Int, (Form m input error view proof a, lbl))]
choices

      viewSubForm :: (FormId, Int, FormId, Form m input error view proof a, lbl, Bool) -> FormState m input (FormId, Int, FormId, view, lbl, Bool)
      viewSubForm :: (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, view, lbl, Bool)
viewSubForm (FormId
fid, Int
vl, FormId
iview, Form m input error view proof a
frm, lbl
lbl, Bool
selected) =
          do FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
             (View error view
v,m (Result error (Proved proof a))
_) <- Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Form m input error view proof a
-> FormState
     m input (View error view, m (Result error (Proved proof a)))
unForm Form m input error view proof a
frm
             (FormId, Int, FormId, view, lbl, Bool)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, view, lbl, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormId
fid, Int
vl, FormId
iview, View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [], lbl
lbl, Bool
selected)

      augmentChoices :: (Monad m) => [(Form m input error view proof a, lbl, Bool)] -> FormState m input [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
      augmentChoices :: [(Form m input error view proof a, lbl, Bool)]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
augmentChoices [(Form m input error view proof a, lbl, Bool)]
choices = ((Int, (Form m input error view proof a, lbl, Bool))
 -> ReaderT
      (Environment m input)
      (StateT FormRange m)
      (FormId, Int, FormId, Form m input error view proof a, lbl, Bool))
-> [(Int, (Form m input error view proof a, lbl, Bool))]
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     [(FormId, Int, FormId, Form m input error view proof a, lbl, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Monad m =>
(Int, (Form m input error view proof a, lbl, Bool))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
(Int, (Form m input error view proof a, lbl, Bool))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
augmentChoice ([Int]
-> [(Form m input error view proof a, lbl, Bool)]
-> [(Int, (Form m input error view proof a, lbl, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Form m input error view proof a, lbl, Bool)]
choices)

      augmentChoice :: (Monad m) => (Int, (Form m input error view proof a, lbl, Bool)) -> FormState m input (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
      augmentChoice :: (Int, (Form m input error view proof a, lbl, Bool))
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
augmentChoice (Int
vl, (Form m input error view proof a
frm, lbl
lbl, Bool
selected)) =
          do FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
             FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
             FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
             FormId
iview <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
             (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
-> ReaderT
     (Environment m input)
     (StateT FormRange m)
     (FormId, Int, FormId, Form m input error view proof a, lbl, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormId
i, Int
vl, FormId
iview, Form m input error view proof a
frm, lbl
lbl, Bool
selected)


{-
              case inp of
                (Found v) ->
                    do let readDec' str = case readDec str of
                                            [(n,[])] -> n
                                            _ -> (-1) -- FIXME: should probably return an internal error?
                           (Right str) = getInputString v :: Either error String -- FIXME
                           key = readDec' str
                           (choices', mval) =
                               foldr (\(i, (a, lbl)) (c, v) ->
                                          if i == key
                                          then ((a,lbl,True) : c, Just a)
                                          else ((a,lbl,False): c,     v))
                                     ([], Nothing) $
                                     zip [0..] choices


-}
-- | used to create @\<label\>@ elements
label :: Monad m =>
         (FormId -> view)
      -> Form m input error view () ()
label :: (FormId -> view) -> Form m input error view () ()
label FormId -> view
f = FormState
  m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () ())))
 -> Form m input error view () ())
-> FormState
     m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall a b. (a -> b) -> a -> b
$ do
    FormId
id' <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
    (View error view, m (Result error (Proved () ())))
-> FormState
     m input (View error view, m (Result error (Proved () ())))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View (view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const (view -> [(FormRange, error)] -> view)
-> view -> [(FormRange, error)] -> view
forall a b. (a -> b) -> a -> b
$ FormId -> view
f FormId
id')
           , Result error (Proved () ()) -> m (Result error (Proved () ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Proved () () -> Result error (Proved () ())
forall e ok. ok -> Result e ok
Ok (Proved () () -> Result error (Proved () ()))
-> Proved () () -> Result error (Proved () ())
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                 , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
id'
                                 , unProved :: ()
unProved = ()
                                 })
           )
-- | used to add a list of error messages to a 'Form'
--
-- This function automatically takes care of extracting only the
-- errors that are relevent to the form element it is attached to via
-- '<++' or '++>'.
errors :: Monad m =>
          ([error] -> view) -- ^ function to convert the error messages into a view
       -> Form m input error view () ()
errors :: ([error] -> view) -> Form m input error view () ()
errors [error] -> view
f = FormState
  m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () ())))
 -> Form m input error view () ())
-> FormState
     m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall a b. (a -> b) -> a -> b
$ do
    FormRange
range <- FormState m input FormRange
forall (m :: * -> *) i. Monad m => FormState m i FormRange
getFormRange
    (View error view, m (Result error (Proved () ())))
-> FormState
     m input (View error view, m (Result error (Proved () ())))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View ([error] -> view
f ([error] -> view)
-> ([(FormRange, error)] -> [error])
-> [(FormRange, error)]
-> view
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormRange -> [(FormRange, error)] -> [error]
forall e. FormRange -> [(FormRange, e)] -> [e]
retainErrors FormRange
range)
           , Result error (Proved () ()) -> m (Result error (Proved () ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Proved () () -> Result error (Proved () ())
forall e ok. ok -> Result e ok
Ok (Proved () () -> Result error (Proved () ()))
-> Proved () () -> Result error (Proved () ())
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                 , pos :: FormRange
pos      = FormRange
range
                                 , unProved :: ()
unProved = ()
                                 })
           )

-- | similar to 'errors' but includes error messages from children of the form as well.
childErrors :: Monad m =>
               ([error] -> view)
            -> Form m input error view () ()
childErrors :: ([error] -> view) -> Form m input error view () ()
childErrors [error] -> view
f = FormState
  m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error view, m (Result error (Proved () ())))
 -> Form m input error view () ())
-> FormState
     m input (View error view, m (Result error (Proved () ())))
-> Form m input error view () ()
forall a b. (a -> b) -> a -> b
$ do
    FormRange
range <- FormState m input FormRange
forall (m :: * -> *) i. Monad m => FormState m i FormRange
getFormRange
    (View error view, m (Result error (Proved () ())))
-> FormState
     m input (View error view, m (Result error (Proved () ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(FormRange, error)] -> view) -> View error view
forall error v. ([(FormRange, error)] -> v) -> View error v
View ([error] -> view
f ([error] -> view)
-> ([(FormRange, error)] -> [error])
-> [(FormRange, error)]
-> view
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormRange -> [(FormRange, error)] -> [error]
forall e. FormRange -> [(FormRange, e)] -> [e]
retainChildErrors FormRange
range)
           , Result error (Proved () ()) -> m (Result error (Proved () ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Proved () () -> Result error (Proved () ())
forall e ok. ok -> Result e ok
Ok (Proved () () -> Result error (Proved () ()))
-> Proved () () -> Result error (Proved () ())
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                 , pos :: FormRange
pos      = FormRange
range
                                 , unProved :: ()
unProved = ()
                                 })
           )