{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
module Text.Reform.Core where
import Control.Applicative (Applicative(pure, (<*>)))
import Control.Applicative.Indexed (IndexedApplicative(ipure, (<<*>>)), IndexedFunctor (imap))
import Control.Arrow (first, second)
import Control.Monad.Reader (MonadReader(ask), ReaderT, runReaderT)
import Control.Monad.State (MonadState(get,put), StateT, evalStateT)
import Control.Monad.Trans (lift)
import Data.Monoid (Monoid(mempty, mappend))
import qualified Data.Semigroup as SG
import Data.Text.Lazy (Text, unpack)
import Text.Reform.Result (FormId(..), FormRange(..), Result(..), unitRange, zeroId)
data Proved proofs a =
Proved { Proved proofs a -> proofs
proofs :: proofs
, Proved proofs a -> FormRange
pos :: FormRange
, Proved proofs a -> a
unProved :: a
}
deriving Int -> Proved proofs a -> ShowS
[Proved proofs a] -> ShowS
Proved proofs a -> String
(Int -> Proved proofs a -> ShowS)
-> (Proved proofs a -> String)
-> ([Proved proofs a] -> ShowS)
-> Show (Proved proofs a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall proofs a.
(Show proofs, Show a) =>
Int -> Proved proofs a -> ShowS
forall proofs a.
(Show proofs, Show a) =>
[Proved proofs a] -> ShowS
forall proofs a. (Show proofs, Show a) => Proved proofs a -> String
showList :: [Proved proofs a] -> ShowS
$cshowList :: forall proofs a.
(Show proofs, Show a) =>
[Proved proofs a] -> ShowS
show :: Proved proofs a -> String
$cshow :: forall proofs a. (Show proofs, Show a) => Proved proofs a -> String
showsPrec :: Int -> Proved proofs a -> ShowS
$cshowsPrec :: forall proofs a.
(Show proofs, Show a) =>
Int -> Proved proofs a -> ShowS
Show
instance Functor (Proved ()) where
fmap :: (a -> b) -> Proved () a -> Proved () b
fmap a -> b
f (Proved () FormRange
pos a
a) = () -> FormRange -> b -> Proved () b
forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved () FormRange
pos (a -> b
f a
a)
unitProved :: FormId -> Proved () ()
unitProved :: FormId -> Proved () ()
unitProved FormId
formId =
Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs = ()
, pos :: FormRange
pos = FormId -> FormRange
unitRange FormId
formId
, unProved :: ()
unProved = ()
}
type FormState m input = ReaderT (Environment m input) (StateT FormRange m)
data Value a
= Default
| Missing
| Found a
getFormInput :: Monad m => FormState m input (Value input)
getFormInput :: FormState m input (Value input)
getFormInput = FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId FormState m input FormId
-> (FormId -> FormState m input (Value input))
-> FormState m input (Value input)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput'
getFormInput' :: Monad m => FormId -> FormState m input (Value input)
getFormInput' :: FormId -> FormState m input (Value input)
getFormInput' FormId
id' = do
Environment m input
env <- ReaderT
(Environment m input) (StateT FormRange m) (Environment m input)
forall r (m :: * -> *). MonadReader r m => m r
ask
case Environment m input
env of
Environment m input
NoEnvironment -> Value input -> FormState m input (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return Value input
forall a. Value a
Default
Environment FormId -> m (Value input)
f ->
StateT FormRange m (Value input) -> FormState m input (Value input)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Value input)
-> FormState m input (Value input))
-> StateT FormRange m (Value input)
-> FormState m input (Value input)
forall a b. (a -> b) -> a -> b
$ m (Value input) -> StateT FormRange m (Value input)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Value input) -> StateT FormRange m (Value input))
-> m (Value input) -> StateT FormRange m (Value input)
forall a b. (a -> b) -> a -> b
$ FormId -> m (Value input)
f FormId
id'
getFormRange :: Monad m => FormState m i FormRange
getFormRange :: FormState m i FormRange
getFormRange = FormState m i FormRange
forall s (m :: * -> *). MonadState s m => m s
get
data Environment m input
= Environment (FormId -> m (Value input))
| NoEnvironment
instance (SG.Semigroup input, Monad m) => SG.Semigroup (Environment m input) where
Environment m input
NoEnvironment <> :: Environment m input -> Environment m input -> Environment m input
<> Environment m input
x = Environment m input
x
Environment m input
x <> Environment m input
NoEnvironment = Environment m input
x
(Environment FormId -> m (Value input)
env1) <> (Environment FormId -> m (Value input)
env2) =
(FormId -> m (Value input)) -> Environment m input
forall (m :: * -> *) input.
(FormId -> m (Value input)) -> Environment m input
Environment ((FormId -> m (Value input)) -> Environment m input)
-> (FormId -> m (Value input)) -> Environment m input
forall a b. (a -> b) -> a -> b
$ \FormId
id' ->
do Value input
r1 <- (FormId -> m (Value input)
env1 FormId
id')
Value input
r2 <- (FormId -> m (Value input)
env2 FormId
id')
case (Value input
r1, Value input
r2) of
(Value input
Missing, Value input
Missing) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return Value input
forall a. Value a
Missing
(Value input
Default, Value input
Missing) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return Value input
forall a. Value a
Default
(Value input
Missing, Value input
Default) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return Value input
forall a. Value a
Default
(Found input
x, Found input
y) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value input -> m (Value input)) -> Value input -> m (Value input)
forall a b. (a -> b) -> a -> b
$ input -> Value input
forall a. a -> Value a
Found (input
x input -> input -> input
forall a. Semigroup a => a -> a -> a
SG.<> input
y)
(Found input
x, Value input
_ ) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value input -> m (Value input)) -> Value input -> m (Value input)
forall a b. (a -> b) -> a -> b
$ input -> Value input
forall a. a -> Value a
Found input
x
(Value input
_ , Found input
y) -> Value input -> m (Value input)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value input -> m (Value input)) -> Value input -> m (Value input)
forall a b. (a -> b) -> a -> b
$ input -> Value input
forall a. a -> Value a
Found input
y
instance (SG.Semigroup input, Monad m) => Monoid (Environment m input) where
mempty :: Environment m input
mempty = Environment m input
forall (m :: * -> *) input. Environment m input
NoEnvironment
mappend :: Environment m input -> Environment m input -> Environment m input
mappend = Environment m input -> Environment m input -> Environment m input
forall a. Semigroup a => a -> a -> a
(SG.<>)
getFormId :: Monad m => FormState m i FormId
getFormId :: FormState m i FormId
getFormId = do
FormRange FormId
x FormId
_ <- ReaderT (Environment m i) (StateT FormRange m) FormRange
forall s (m :: * -> *). MonadState s m => m s
get
FormId -> FormState m i FormId
forall (m :: * -> *) a. Monad m => a -> m a
return FormId
x
incFormId :: Monad m => FormState m i ()
incFormId :: FormState m i ()
incFormId = do
FormRange FormId
_ FormId
endF1 <- ReaderT (Environment m i) (StateT FormRange m) FormRange
forall s (m :: * -> *). MonadState s m => m s
get
FormRange -> FormState m i ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FormRange -> FormState m i ()) -> FormRange -> FormState m i ()
forall a b. (a -> b) -> a -> b
$ FormId -> FormRange
unitRange FormId
endF1
newtype View error v = View
{ View error v -> [(FormRange, error)] -> v
unView :: [(FormRange, error)] -> v
} deriving (b -> View error v -> View error v
NonEmpty (View error v) -> View error v
View error v -> View error v -> View error v
(View error v -> View error v -> View error v)
-> (NonEmpty (View error v) -> View error v)
-> (forall b. Integral b => b -> View error v -> View error v)
-> Semigroup (View error v)
forall b. Integral b => b -> View error v -> View error v
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall error v.
Semigroup v =>
NonEmpty (View error v) -> View error v
forall error v.
Semigroup v =>
View error v -> View error v -> View error v
forall error v b.
(Semigroup v, Integral b) =>
b -> View error v -> View error v
stimes :: b -> View error v -> View error v
$cstimes :: forall error v b.
(Semigroup v, Integral b) =>
b -> View error v -> View error v
sconcat :: NonEmpty (View error v) -> View error v
$csconcat :: forall error v.
Semigroup v =>
NonEmpty (View error v) -> View error v
<> :: View error v -> View error v -> View error v
$c<> :: forall error v.
Semigroup v =>
View error v -> View error v -> View error v
SG.Semigroup, Semigroup (View error v)
View error v
Semigroup (View error v)
-> View error v
-> (View error v -> View error v -> View error v)
-> ([View error v] -> View error v)
-> Monoid (View error v)
[View error v] -> View error v
View error v -> View error v -> View error v
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall error v. Monoid v => Semigroup (View error v)
forall error v. Monoid v => View error v
forall error v. Monoid v => [View error v] -> View error v
forall error v.
Monoid v =>
View error v -> View error v -> View error v
mconcat :: [View error v] -> View error v
$cmconcat :: forall error v. Monoid v => [View error v] -> View error v
mappend :: View error v -> View error v -> View error v
$cmappend :: forall error v.
Monoid v =>
View error v -> View error v -> View error v
mempty :: View error v
$cmempty :: forall error v. Monoid v => View error v
$cp1Monoid :: forall error v. Monoid v => Semigroup (View error v)
Monoid)
instance Functor (View e) where
fmap :: (a -> b) -> View e a -> View e b
fmap a -> b
f (View [(FormRange, e)] -> a
g) = ([(FormRange, e)] -> b) -> View e b
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, e)] -> b) -> View e b)
-> ([(FormRange, e)] -> b) -> View e b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> ([(FormRange, e)] -> a) -> [(FormRange, e)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FormRange, e)] -> a
g
newtype Form m input error view proof a = Form { Form m input error view proof a
-> FormState
m input (View error view, m (Result error (Proved proof a)))
unForm :: FormState m input (View error view, m (Result error (Proved proof a))) }
instance (Monad m) => IndexedFunctor (Form m input view error) where
imap :: (x -> y)
-> (a -> b)
-> Form m input view error x a
-> Form m input view error y b
imap x -> y
f a -> b
g (Form FormState m input (View view error, m (Result view (Proved x a)))
frm) =
FormState m input (View view error, m (Result view (Proved y b)))
-> Form m input view error y b
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 view error, m (Result view (Proved y b)))
-> Form m input view error y b)
-> FormState
m input (View view error, m (Result view (Proved y b)))
-> Form m input view error y b
forall a b. (a -> b) -> a -> b
$ do (View view error
view, m (Result view (Proved x a))
mval) <- FormState m input (View view error, m (Result view (Proved x a)))
frm
Result view (Proved x a)
val <- StateT FormRange m (Result view (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result view (Proved x a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result view (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result view (Proved x a)))
-> StateT FormRange m (Result view (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result view (Proved x a))
forall a b. (a -> b) -> a -> b
$ m (Result view (Proved x a))
-> StateT FormRange m (Result view (Proved x a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result view (Proved x a))
-> StateT FormRange m (Result view (Proved x a)))
-> m (Result view (Proved x a))
-> StateT FormRange m (Result view (Proved x a))
forall a b. (a -> b) -> a -> b
$ m (Result view (Proved x a))
mval
case Result view (Proved x a)
val of
(Ok (Proved x
p FormRange
pos a
a)) -> (View view error, m (Result view (Proved y b)))
-> FormState
m input (View view error, m (Result view (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View view error
view, Result view (Proved y b) -> m (Result view (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result view (Proved y b) -> m (Result view (Proved y b)))
-> Result view (Proved y b) -> m (Result view (Proved y b))
forall a b. (a -> b) -> a -> b
$ Proved y b -> Result view (Proved y b)
forall e ok. ok -> Result e ok
Ok (y -> FormRange -> b -> Proved y b
forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved (x -> y
f x
p) FormRange
pos (a -> b
g a
a)))
(Error [(FormRange, view)]
errs) -> (View view error, m (Result view (Proved y b)))
-> FormState
m input (View view error, m (Result view (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View view error
view, Result view (Proved y b) -> m (Result view (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result view (Proved y b) -> m (Result view (Proved y b)))
-> Result view (Proved y b) -> m (Result view (Proved y b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, view)] -> Result view (Proved y b)
forall e ok. [(FormRange, e)] -> Result e ok
Error [(FormRange, view)]
errs)
instance (Monoid view, Monad m) => IndexedApplicative (Form m input error view) where
ipure :: x -> a -> Form m input error view x a
ipure x
p a
a = FormState m input (View error view, m (Result error (Proved x a)))
-> Form m input error view x 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 x a)))
-> Form m input error view x a)
-> FormState
m input (View error view, m (Result error (Proved x a)))
-> Form m input error view x 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
(View error view, m (Result error (Proved x a)))
-> FormState
m input (View error view, m (Result error (Proved x a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
forall a. Monoid a => a
mempty, Result error (Proved x a) -> m (Result error (Proved x a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved x a) -> m (Result error (Proved x a)))
-> Result error (Proved x a) -> m (Result error (Proved x a))
forall a b. (a -> b) -> a -> b
$ Proved x a -> Result error (Proved x a)
forall e ok. ok -> Result e ok
Ok (x -> FormRange -> a -> Proved x a
forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved x
p (FormId -> FormRange
unitRange FormId
i) a
a))
(Form FormState
m
input
(View error view, m (Result error (Proved (x -> y) (a -> b))))
frmF) <<*>> :: Form m input error view (x -> y) (a -> b)
-> Form m input error view x a -> Form m input error view y b
<<*>> (Form FormState m input (View error view, m (Result error (Proved x a)))
frmA) =
FormState m input (View error view, m (Result error (Proved y b)))
-> Form m input error view y b
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 y b)))
-> Form m input error view y b)
-> FormState
m input (View error view, m (Result error (Proved y b)))
-> Form m input error view y b
forall a b. (a -> b) -> a -> b
$ do ((View error view
view1, m (Result error (Proved (x -> y) (a -> b)))
mfok), (View error view
view2, m (Result error (Proved x a))
maok)) <- FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
-> FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
forall (m :: * -> *) input a.
Monad m =>
FormState m input a -> FormState m input a
bracketState (FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
-> FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a)))))
-> FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
-> FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
forall a b. (a -> b) -> a -> b
$
do (View error view, m (Result error (Proved (x -> y) (a -> b))))
res1 <- FormState
m
input
(View error view, m (Result error (Proved (x -> y) (a -> b))))
frmF
FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
(View error view, m (Result error (Proved x a)))
res2 <- FormState m input (View error view, m (Result error (Proved x a)))
frmA
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
-> FormState
m
input
((View error view, m (Result error (Proved (x -> y) (a -> b)))),
(View error view, m (Result error (Proved x a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ((View error view, m (Result error (Proved (x -> y) (a -> b))))
res1, (View error view, m (Result error (Proved x a)))
res2)
Result error (Proved (x -> y) (a -> b))
fok <- StateT FormRange m (Result error (Proved (x -> y) (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved (x -> y) (a -> b)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result error (Proved (x -> y) (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved (x -> y) (a -> b))))
-> StateT FormRange m (Result error (Proved (x -> y) (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved (x -> y) (a -> b)))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved (x -> y) (a -> b)))
-> StateT FormRange m (Result error (Proved (x -> y) (a -> b)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result error (Proved (x -> y) (a -> b)))
-> StateT FormRange m (Result error (Proved (x -> y) (a -> b))))
-> m (Result error (Proved (x -> y) (a -> b)))
-> StateT FormRange m (Result error (Proved (x -> y) (a -> b)))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved (x -> y) (a -> b)))
mfok
Result error (Proved x a)
aok <- StateT FormRange m (Result error (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved x a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result error (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved x a)))
-> StateT FormRange m (Result error (Proved x a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved x a))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved x a))
-> StateT FormRange m (Result error (Proved x a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result error (Proved x a))
-> StateT FormRange m (Result error (Proved x a)))
-> m (Result error (Proved x a))
-> StateT FormRange m (Result error (Proved x a))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved x a))
maok
case (Result error (Proved (x -> y) (a -> b))
fok, Result error (Proved x a)
aok) of
(Error [(FormRange, error)]
errs1, Error [(FormRange, error)]
errs2) -> (View error view, m (Result error (Proved y b)))
-> FormState
m input (View error view, m (Result error (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved y b) -> m (Result error (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved y b) -> m (Result error (Proved y b)))
-> Result error (Proved y b) -> m (Result error (Proved y b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved y b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved y b))
-> [(FormRange, error)] -> Result error (Proved y b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs1 [(FormRange, error)]
-> [(FormRange, error)] -> [(FormRange, error)]
forall a. [a] -> [a] -> [a]
++ [(FormRange, error)]
errs2)
(Error [(FormRange, error)]
errs1, Result error (Proved x a)
_) -> (View error view, m (Result error (Proved y b)))
-> FormState
m input (View error view, m (Result error (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved y b) -> m (Result error (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved y b) -> m (Result error (Proved y b)))
-> Result error (Proved y b) -> m (Result error (Proved y b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved y b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved y b))
-> [(FormRange, error)] -> Result error (Proved y b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs1)
(Result error (Proved (x -> y) (a -> b))
_ , Error [(FormRange, error)]
errs2) -> (View error view, m (Result error (Proved y b)))
-> FormState
m input (View error view, m (Result error (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved y b) -> m (Result error (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved y b) -> m (Result error (Proved y b)))
-> Result error (Proved y b) -> m (Result error (Proved y b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved y b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved y b))
-> [(FormRange, error)] -> Result error (Proved y b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs2)
(Ok (Proved x -> y
p (FormRange FormId
x FormId
_) a -> b
f), Ok (Proved x
q (FormRange FormId
_ FormId
y) a
a)) ->
(View error view, m (Result error (Proved y b)))
-> FormState
m input (View error view, m (Result error (Proved y b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved y b) -> m (Result error (Proved y b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved y b) -> m (Result error (Proved y b)))
-> Result error (Proved y b) -> m (Result error (Proved y b))
forall a b. (a -> b) -> a -> b
$ Proved y b -> Result error (Proved y b)
forall e ok. ok -> Result e ok
Ok (Proved y b -> Result error (Proved y b))
-> Proved y b -> Result error (Proved y b)
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: y
proofs = x -> y
p x
q
, pos :: FormRange
pos = FormId -> FormId -> FormRange
FormRange FormId
x FormId
y
, unProved :: b
unProved = a -> b
f a
a
})
bracketState :: Monad m => FormState m input a -> FormState m input a
bracketState :: FormState m input a -> FormState m input a
bracketState FormState m input a
k = do
FormRange FormId
startF1 FormId
_ <- ReaderT (Environment m input) (StateT FormRange m) FormRange
forall s (m :: * -> *). MonadState s m => m s
get
a
res <- FormState m input a
k
FormRange FormId
_ FormId
endF2 <- ReaderT (Environment m input) (StateT FormRange m) FormRange
forall s (m :: * -> *). MonadState s m => m s
get
FormRange -> ReaderT (Environment m input) (StateT FormRange m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FormRange
-> ReaderT (Environment m input) (StateT FormRange m) ())
-> FormRange
-> ReaderT (Environment m input) (StateT FormRange m) ()
forall a b. (a -> b) -> a -> b
$ FormId -> FormId -> FormRange
FormRange FormId
startF1 FormId
endF2
a -> FormState m input a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
instance (Functor m) => Functor (Form m input error view ()) where
fmap :: (a -> b)
-> Form m input error view () a -> Form m input error view () b
fmap a -> b
f Form m input error view () a
form =
FormState m input (View error view, m (Result error (Proved () b)))
-> Form m input error view () b
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 () b)))
-> Form m input error view () b)
-> FormState
m input (View error view, m (Result error (Proved () b)))
-> Form m input error view () b
forall a b. (a -> b) -> a -> b
$ ((View error view, m (Result error (Proved () a)))
-> (View error view, m (Result error (Proved () b))))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(View error view, m (Result error (Proved () a)))
-> FormState
m input (View error view, m (Result error (Proved () b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m (Result error (Proved () a)) -> m (Result error (Proved () b)))
-> (View error view, m (Result error (Proved () a)))
-> (View error view, m (Result error (Proved () b)))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Result error (Proved () a) -> Result error (Proved () b))
-> m (Result error (Proved () a)) -> m (Result error (Proved () b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Proved () a -> Proved () b)
-> Result error (Proved () a) -> Result error (Proved () b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Proved () a -> Proved () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)))) (Form m input error view () a
-> ReaderT
(Environment m input)
(StateT FormRange m)
(View error view, m (Result error (Proved () 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 () a
form)
instance (Functor m, Monoid view, Monad m) => Applicative (Form m input error view ()) where
pure :: a -> Form m input error view () a
pure a
a =
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
(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
forall a. Monoid a => a
mempty, 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 () a -> Result error (Proved () a))
-> Proved () a -> Result error (Proved () a)
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs = ()
, pos :: FormRange
pos = FormId -> FormId -> FormRange
FormRange FormId
i FormId
i
, unProved :: a
unProved = a
a
})
(Form FormState
m input (View error view, m (Result error (Proved () (a -> b))))
frmF) <*> :: Form m input error view () (a -> b)
-> Form m input error view () a -> Form m input error view () b
<*> (Form FormState m input (View error view, m (Result error (Proved () a)))
frmA) =
FormState m input (View error view, m (Result error (Proved () b)))
-> Form m input error view () b
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 () b)))
-> Form m input error view () b)
-> FormState
m input (View error view, m (Result error (Proved () b)))
-> Form m input error view () b
forall a b. (a -> b) -> a -> b
$
do ((View error view
view1, m (Result error (Proved () (a -> b)))
mfok), (View error view
view2, m (Result error (Proved () a))
maok)) <- FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
-> FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
forall (m :: * -> *) input a.
Monad m =>
FormState m input a -> FormState m input a
bracketState (FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
-> FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a)))))
-> FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
-> FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
forall a b. (a -> b) -> a -> b
$
do (View error view, m (Result error (Proved () (a -> b))))
res1 <- FormState
m input (View error view, m (Result error (Proved () (a -> b))))
frmF
FormState m input ()
forall (m :: * -> *) i. Monad m => FormState m i ()
incFormId
(View error view, m (Result error (Proved () a)))
res2 <- FormState m input (View error view, m (Result error (Proved () a)))
frmA
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
-> FormState
m
input
((View error view, m (Result error (Proved () (a -> b)))),
(View error view, m (Result error (Proved () a))))
forall (m :: * -> *) a. Monad m => a -> m a
return ((View error view, m (Result error (Proved () (a -> b))))
res1, (View error view, m (Result error (Proved () a)))
res2)
Result error (Proved () (a -> b))
fok <- StateT FormRange m (Result error (Proved () (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () (a -> b)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result error (Proved () (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () (a -> b))))
-> StateT FormRange m (Result error (Proved () (a -> b)))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () (a -> b)))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved () (a -> b)))
-> StateT FormRange m (Result error (Proved () (a -> b)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result error (Proved () (a -> b)))
-> StateT FormRange m (Result error (Proved () (a -> b))))
-> m (Result error (Proved () (a -> b)))
-> StateT FormRange m (Result error (Proved () (a -> b)))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved () (a -> b)))
mfok
Result error (Proved () a)
aok <- StateT FormRange m (Result error (Proved () a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT FormRange m (Result error (Proved () a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () a)))
-> StateT FormRange m (Result error (Proved () a))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved () a))
-> StateT FormRange m (Result error (Proved () a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result error (Proved () a))
-> StateT FormRange m (Result error (Proved () a)))
-> m (Result error (Proved () a))
-> StateT FormRange m (Result error (Proved () a))
forall a b. (a -> b) -> a -> b
$ m (Result error (Proved () a))
maok
case (Result error (Proved () (a -> b))
fok, Result error (Proved () a)
aok) of
(Error [(FormRange, error)]
errs1, Error [(FormRange, error)]
errs2) -> (View error view, m (Result error (Proved () b)))
-> FormState
m input (View error view, m (Result error (Proved () b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved () b) -> m (Result error (Proved () b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () b) -> m (Result error (Proved () b)))
-> Result error (Proved () b) -> m (Result error (Proved () b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved () b))
-> [(FormRange, error)] -> Result error (Proved () b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs1 [(FormRange, error)]
-> [(FormRange, error)] -> [(FormRange, error)]
forall a. [a] -> [a] -> [a]
++ [(FormRange, error)]
errs2)
(Error [(FormRange, error)]
errs1, Result error (Proved () a)
_) -> (View error view, m (Result error (Proved () b)))
-> FormState
m input (View error view, m (Result error (Proved () b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved () b) -> m (Result error (Proved () b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () b) -> m (Result error (Proved () b)))
-> Result error (Proved () b) -> m (Result error (Proved () b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved () b))
-> [(FormRange, error)] -> Result error (Proved () b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs1)
(Result error (Proved () (a -> b))
_ , Error [(FormRange, error)]
errs2) -> (View error view, m (Result error (Proved () b)))
-> FormState
m input (View error view, m (Result error (Proved () b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved () b) -> m (Result error (Proved () b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () b) -> m (Result error (Proved () b)))
-> Result error (Proved () b) -> m (Result error (Proved () b))
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)] -> Result error (Proved () b)
forall e ok. [(FormRange, e)] -> Result e ok
Error ([(FormRange, error)] -> Result error (Proved () b))
-> [(FormRange, error)] -> Result error (Proved () b)
forall a b. (a -> b) -> a -> b
$ [(FormRange, error)]
errs2)
(Ok (Proved ()
p (FormRange FormId
x FormId
_) a -> b
f), Ok (Proved ()
q (FormRange FormId
_ FormId
y) a
a)) ->
(View error view, m (Result error (Proved () b)))
-> FormState
m input (View error view, m (Result error (Proved () b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view
view1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
view2, Result error (Proved () b) -> m (Result error (Proved () b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result error (Proved () b) -> m (Result error (Proved () b)))
-> Result error (Proved () b) -> m (Result error (Proved () b))
forall a b. (a -> b) -> a -> b
$ Proved () b -> Result error (Proved () b)
forall e ok. ok -> Result e ok
Ok (Proved () b -> Result error (Proved () b))
-> Proved () b -> Result error (Proved () b)
forall a b. (a -> b) -> a -> b
$ Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs = ()
, pos :: FormRange
pos = FormId -> FormId -> FormRange
FormRange FormId
x FormId
y
, unProved :: b
unProved = a -> b
f a
a
})
runForm :: (Monad m) =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm :: Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm Environment m input
env Text
prefix' Form m input error view proof a
form =
StateT
FormRange m (View error view, m (Result error (Proved proof a)))
-> FormRange
-> m (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ReaderT
(Environment m input)
(StateT FormRange m)
(View error view, m (Result error (Proved proof a)))
-> Environment m input
-> StateT
FormRange m (View error view, m (Result error (Proved proof a)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Form m input error view proof a
-> ReaderT
(Environment m input)
(StateT FormRange m)
(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
form) Environment m input
env) (FormId -> FormRange
unitRange (String -> FormId
zeroId (String -> FormId) -> String -> FormId
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
prefix'))
runForm' :: (Monad m) =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (view , Maybe a)
runForm' :: Environment m input
-> Text -> Form m input error view proof a -> m (view, Maybe a)
runForm' Environment m input
env Text
prefix Form m input error view proof a
form =
do (View error view
view', m (Result error (Proved proof a))
mresult) <- Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Monad m =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm Environment m input
env Text
prefix Form m input error view proof a
form
Result error (Proved proof a)
result <- m (Result error (Proved proof a))
mresult
(view, Maybe a) -> m (view, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((view, Maybe a) -> m (view, Maybe a))
-> (view, Maybe a) -> m (view, Maybe a)
forall a b. (a -> b) -> a -> b
$ case Result error (Proved proof a)
result of
Error [(FormRange, error)]
e -> (View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
view' [(FormRange, error)]
e , Maybe a
forall a. Maybe a
Nothing)
Ok Proved proof a
x -> (View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
view' [], a -> Maybe a
forall a. a -> Maybe a
Just (Proved proof a -> a
forall proofs a. Proved proofs a -> a
unProved Proved proof a
x))
viewForm :: (Monad m) =>
Text
-> Form m input error view proof a
-> m view
viewForm :: Text -> Form m input error view proof a -> m view
viewForm Text
prefix Form m input error view proof a
form =
do (View error view
v, m (Result error (Proved proof a))
_) <- Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Monad m =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm Environment m input
forall (m :: * -> *) input. Environment m input
NoEnvironment Text
prefix Form m input error view proof a
form
view -> m view
forall (m :: * -> *) a. Monad m => a -> m a
return (View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [])
eitherForm :: (Monad m) =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (Either view a)
eitherForm :: Environment m input
-> Text -> Form m input error view proof a -> m (Either view a)
eitherForm Environment m input
env Text
id' Form m input error view proof a
form = do
(View error view
view', m (Result error (Proved proof a))
mresult) <- Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Monad m =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm Environment m input
env Text
id' Form m input error view proof a
form
Result error (Proved proof a)
result <- m (Result error (Proved proof a))
mresult
Either view a -> m (Either view a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either view a -> m (Either view a))
-> Either view a -> m (Either view a)
forall a b. (a -> b) -> a -> b
$ case Result error (Proved proof a)
result of
Error [(FormRange, error)]
e -> view -> Either view a
forall a b. a -> Either a b
Left (view -> Either view a) -> view -> Either view a
forall a b. (a -> b) -> a -> b
$ View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
view' [(FormRange, error)]
e
Ok Proved proof a
x -> a -> Either view a
forall a b. b -> Either a b
Right (Proved proof a -> a
forall proofs a. Proved proofs a -> a
unProved Proved proof a
x)
view :: (Monad m) =>
view
-> Form m input error view () ()
view :: view -> Form m input error view () ()
view view
view' =
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 (view -> [(FormRange, error)] -> view
forall a b. a -> b -> a
const view
view')
, 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 :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs = ()
, pos :: FormRange
pos = FormId -> FormId -> FormRange
FormRange FormId
i FormId
i
, unProved :: ()
unProved = ()
})))
(++>) :: (Monad m, Monoid view)
=> Form m input error view () ()
-> Form m input error view proof a
-> Form m input error view proof a
Form m input error view () ()
f1 ++> :: Form m input error view () ()
-> Form m input error view proof a
-> Form m input error view proof a
++> Form m input error view proof a
f2 = 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
(View error view
v2, m (Result error (Proved proof a))
r) <- 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
f2
(View error view
v1, m (Result error (Proved () ()))
_) <- Form m input error view () ()
-> FormState
m input (View error view, m (Result error (Proved () ())))
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 () ()
f1
(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 (View error view
v1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
v2, m (Result error (Proved proof a))
r)
infixl 6 ++>
(<++) :: (Monad m, Monoid view)
=> Form m input error view proof a
-> Form m input error view () ()
-> Form m input error view proof a
Form m input error view proof a
f1 <++ :: Form m input error view proof a
-> Form m input error view () () -> Form m input error view proof a
<++ Form m input error view () ()
f2 = 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
(View error view
v1, m (Result error (Proved proof a))
r) <- 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
f1
(View error view
v2, m (Result error (Proved () ()))
_) <- Form m input error view () ()
-> FormState
m input (View error view, m (Result error (Proved () ())))
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 () ()
f2
(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 (View error view
v1 View error view -> View error view -> View error view
forall a. Monoid a => a -> a -> a
`mappend` View error view
v2, m (Result error (Proved proof a))
r)
infixr 5 <++
mapView :: (Monad m, Functor m)
=> (view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView :: (view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView view -> view'
f = 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)
-> (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
-> Form m input error view' proof a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((View error view, m (Result error (Proved proof a)))
-> (View error view', m (Result error (Proved proof a))))
-> ReaderT
(Environment m input)
(StateT FormRange m)
(View error view, m (Result error (Proved proof a)))
-> FormState
m input (View error view', m (Result error (Proved proof a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((View error view -> View error view')
-> (View error view, m (Result error (Proved proof a)))
-> (View error view', m (Result error (Proved proof a)))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((View error view -> View error view')
-> (View error view, m (Result error (Proved proof a)))
-> (View error view', m (Result error (Proved proof a))))
-> (View error view -> View error view')
-> (View error view, m (Result error (Proved proof a)))
-> (View error view', m (Result error (Proved proof a)))
forall a b. (a -> b) -> a -> b
$ (view -> view') -> View error view -> View error view'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap view -> view'
f) (ReaderT
(Environment m input)
(StateT FormRange m)
(View error view, m (Result error (Proved proof a)))
-> FormState
m input (View error view', m (Result error (Proved proof a))))
-> (Form m input error view proof a
-> ReaderT
(Environment m input)
(StateT FormRange m)
(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)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form m input error view proof a
-> ReaderT
(Environment m input)
(StateT FormRange m)
(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
mkOk :: (Monad m) =>
FormId
-> view
-> a
-> FormState m input (View error view, m (Result error (Proved () a)))
mkOk :: FormId
-> view
-> a
-> FormState
m input (View error view, m (Result error (Proved () a)))
mkOk FormId
i view
view a
val =
(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
$ 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
val
})
)