{-# LANGUAGE ScopedTypeVariables, TypeFamilies, ViewPatterns #-}
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
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))]
)
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
})
)
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 = ()
})
)
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
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
inputMulti :: forall m input error view a lbl. (Functor m, FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
[(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> (a -> Bool)
-> 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 ->
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)
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)
inputChoice :: forall a m error input lbl view. (Functor m, FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
(a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> 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 ->
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)
(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
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)
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)]
-> (FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> 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
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 [(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 ->
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)
(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
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
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)
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 = ()
})
)
errors :: Monad m =>
([error] -> 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 = ()
})
)
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 = ()
})
)