{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
module Text.Pandoc.Readers.Odt.Arrows.State where
import Control.Arrow
import qualified Control.Category as Cat
import Control.Monad
import Text.Pandoc.Readers.Odt.Arrows.Utils
import Text.Pandoc.Readers.Odt.Generic.Fallible
newtype ArrowState state a b = ArrowState
{ ArrowState state a b -> (state, a) -> (state, b)
runArrowState :: (state, a) -> (state, b) }
withState :: (state -> a -> (state, b)) -> ArrowState state a b
withState :: (state -> a -> (state, b)) -> ArrowState state a b
withState = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((state -> a -> (state, b)) -> (state, a) -> (state, b))
-> (state -> a -> (state, b))
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (state -> a -> (state, b)) -> (state, a) -> (state, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
modifyState :: (state -> state ) -> ArrowState state a a
modifyState :: (state -> state) -> ArrowState state a a
modifyState = ((state, a) -> (state, a)) -> ArrowState state a a
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, a)) -> ArrowState state a a)
-> ((state -> state) -> (state, a) -> (state, a))
-> (state -> state)
-> ArrowState state a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (state -> state) -> (state, a) -> (state, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
ignoringState :: ( a -> b ) -> ArrowState state a b
ignoringState :: (a -> b) -> ArrowState state a b
ignoringState = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((a -> b) -> (state, a) -> (state, b))
-> (a -> b)
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (state, a) -> (state, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
fromState :: (state -> (state, b)) -> ArrowState state a b
fromState :: (state -> (state, b)) -> ArrowState state a b
fromState = ((state, a) -> (state, b)) -> ArrowState state a b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, b)) -> ArrowState state a b)
-> ((state -> (state, b)) -> (state, a) -> (state, b))
-> (state -> (state, b))
-> ArrowState state a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((state -> (state, b))
-> ((state, a) -> state) -> (state, a) -> (state, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(state, a) -> state
forall a b. (a, b) -> a
fst)
extractFromState :: (state -> b ) -> ArrowState state x b
state -> b
f = ((state, x) -> (state, b)) -> ArrowState state x b
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, x) -> (state, b)) -> ArrowState state x b)
-> ((state, x) -> (state, b)) -> ArrowState state x b
forall a b. (a -> b) -> a -> b
$ \(state
state,x
_) -> (state
state, state -> b
f state
state)
tryModifyState :: (state -> Either f state)
-> ArrowState state a (Either f a)
tryModifyState :: (state -> Either f state) -> ArrowState state a (Either f a)
tryModifyState state -> Either f state
f = ((state, a) -> (state, Either f a))
-> ArrowState state a (Either f a)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, a) -> (state, Either f a))
-> ArrowState state a (Either f a))
-> ((state, a) -> (state, Either f a))
-> ArrowState state a (Either f a)
forall a b. (a -> b) -> a -> b
$ \(state
state,a
a)
-> (state
state,)(Either f a -> (state, Either f a))
-> (f -> Either f a) -> f -> (state, Either f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.f -> Either f a
forall a b. a -> Either a b
Left (f -> (state, Either f a))
-> (state -> (state, Either f a))
-> Either f state
-> (state, Either f a)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (,a -> Either f a
forall a b. b -> Either a b
Right a
a) (Either f state -> (state, Either f a))
-> Either f state -> (state, Either f a)
forall a b. (a -> b) -> a -> b
$ state -> Either f state
f state
state
instance Cat.Category (ArrowState s) where
id :: ArrowState s a a
id = ((s, a) -> (s, a)) -> ArrowState s a a
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (s, a) -> (s, a)
forall a. a -> a
id
ArrowState s b c
arrow2 . :: ArrowState s b c -> ArrowState s a b -> ArrowState s a c
. ArrowState s a b
arrow1 = ((s, a) -> (s, c)) -> ArrowState s a c
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, a) -> (s, c)) -> ArrowState s a c)
-> ((s, a) -> (s, c)) -> ArrowState s a c
forall a b. (a -> b) -> a -> b
$ ArrowState s b c -> (s, b) -> (s, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s b c
arrow2 ((s, b) -> (s, c)) -> ((s, a) -> (s, b)) -> (s, a) -> (s, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrowState s a b -> (s, a) -> (s, b)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s a b
arrow1
instance Arrow (ArrowState state) where
arr :: (b -> c) -> ArrowState state b c
arr = (b -> c) -> ArrowState state b c
forall a b state. (a -> b) -> ArrowState state a b
ignoringState
first :: ArrowState state b c -> ArrowState state (b, d) (c, d)
first ArrowState state b c
a = ((state, (b, d)) -> (state, (c, d)))
-> ArrowState state (b, d) (c, d)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (b, d)) -> (state, (c, d)))
-> ArrowState state (b, d) (c, d))
-> ((state, (b, d)) -> (state, (c, d)))
-> ArrowState state (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \(state
s,(b
aF,d
aS))
-> (c -> (c, d)) -> (state, c) -> (state, (c, d))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (,d
aS) ((state, c) -> (state, (c, d))) -> (state, c) -> (state, (c, d))
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
aF)
second :: ArrowState state b c -> ArrowState state (d, b) (d, c)
second ArrowState state b c
a = ((state, (d, b)) -> (state, (d, c)))
-> ArrowState state (d, b) (d, c)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (d, b)) -> (state, (d, c)))
-> ArrowState state (d, b) (d, c))
-> ((state, (d, b)) -> (state, (d, c)))
-> ArrowState state (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ \(state
s,(d
aF,b
aS))
-> (c -> (d, c)) -> (state, c) -> (state, (d, c))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (d
aF,) ((state, c) -> (state, (d, c))) -> (state, c) -> (state, (d, c))
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
aS)
instance ArrowChoice (ArrowState state) where
left :: ArrowState state b c -> ArrowState state (Either b d) (Either c d)
left ArrowState state b c
a = ((state, Either b d) -> (state, Either c d))
-> ArrowState state (Either b d) (Either c d)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, Either b d) -> (state, Either c d))
-> ArrowState state (Either b d) (Either c d))
-> ((state, Either b d) -> (state, Either c d))
-> ArrowState state (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \(state
s,Either b d
e) -> case Either b d
e of
Left b
l -> (c -> Either c d) -> (state, c) -> (state, Either c d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> Either c d
forall a b. a -> Either a b
Left ((state, c) -> (state, Either c d))
-> (state, c) -> (state, Either c d)
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
l)
Right d
r -> (state
s, d -> Either c d
forall a b. b -> Either a b
Right d
r)
right :: ArrowState state b c -> ArrowState state (Either d b) (Either d c)
right ArrowState state b c
a = ((state, Either d b) -> (state, Either d c))
-> ArrowState state (Either d b) (Either d c)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, Either d b) -> (state, Either d c))
-> ArrowState state (Either d b) (Either d c))
-> ((state, Either d b) -> (state, Either d c))
-> ArrowState state (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$ \(state
s,Either d b
e) -> case Either d b
e of
Left d
l -> (state
s, d -> Either d c
forall a b. a -> Either a b
Left d
l)
Right b
r -> (c -> Either d c) -> (state, c) -> (state, Either d c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> Either d c
forall a b. b -> Either a b
Right ((state, c) -> (state, Either d c))
-> (state, c) -> (state, Either d c)
forall a b. (a -> b) -> a -> b
$ ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
a (state
s,b
r)
instance ArrowApply (ArrowState state) where
app :: ArrowState state (ArrowState state b c, b) c
app = ((state, (ArrowState state b c, b)) -> (state, c))
-> ArrowState state (ArrowState state b c, b) c
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((state, (ArrowState state b c, b)) -> (state, c))
-> ArrowState state (ArrowState state b c, b) c)
-> ((state, (ArrowState state b c, b)) -> (state, c))
-> ArrowState state (ArrowState state b c, b) c
forall a b. (a -> b) -> a -> b
$ \(state
s, (ArrowState state b c
f,b
b)) -> ArrowState state b c -> (state, b) -> (state, c)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState state b c
f (state
s,b
b)
withSubStateF :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s )
-> ArrowState s x (Either f x )
withSubStateF :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f x)
withSubStateF ArrowState s x (Either f s')
unlift ArrowState s' s (Either f s)
a = ArrowState s x (Either f s') -> ArrowState s x (x, Either f s')
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
forall s x f s'.
ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
withSubStateF' ArrowState s x (Either f s')
unlift ArrowState s' s (Either f s)
a)
ArrowState s x (x, Either f s')
-> ((x, Either f s') -> Either f x) -> ArrowState s x (Either f x)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (x, Either f s') -> Either f (x, s')
forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice
((x, Either f s') -> Either f (x, s'))
-> (Either f (x, s') -> Either f x)
-> (x, Either f s')
-> Either f x
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ((x, s') -> x) -> Either f (x, s') -> Either f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, s') -> x
forall a b. (a, b) -> a
fst
withSubStateF' :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s )
-> ArrowState s x (Either f s')
withSubStateF' :: ArrowState s x (Either f s')
-> ArrowState s' s (Either f s) -> ArrowState s x (Either f s')
withSubStateF' ArrowState s x (Either f s')
unlift ArrowState s' s (Either f s)
a = ((s, x) -> (s, Either f s')) -> ArrowState s x (Either f s')
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (s, x) -> (s, Either f s')
go
where go :: (s, x) -> (s, Either f s')
go p :: (s, x)
p@(s
s,x
_) = ArrowState s x (Either f s')
-> ((s', s) -> (s, Either f s')) -> (s, x) -> (s, Either f s')
forall b a a a b.
ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning ArrowState s x (Either f s')
unlift
( ArrowState s' s (Either f s)
-> ((s, s') -> (s, Either f s')) -> (s', s) -> (s, Either f s')
forall b a a a b.
ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning ArrowState s' s (Either f s)
a ((s' -> Either f s') -> (s, s') -> (s, Either f s')
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second s' -> Either f s'
forall a b. b -> Either a b
Right) )
(s, x)
p
where tryRunning :: ArrowState b a (Either a a)
-> ((a, b) -> (s, Either a b)) -> (b, a) -> (s, Either a b)
tryRunning ArrowState b a (Either a a)
a' (a, b) -> (s, Either a b)
b (b, a)
v = case ArrowState b a (Either a a) -> (b, a) -> (b, Either a a)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState b a (Either a a)
a' (b, a)
v of
(b
_ , Left a
f) -> (s
s, a -> Either a b
forall a b. a -> Either a b
Left a
f)
(b
x , Right a
y) -> (a, b) -> (s, Either a b)
b (a
y,b
x)
foldS :: (Foldable f, Monoid m) => ArrowState s x m -> ArrowState s (f x) m
foldS :: ArrowState s x m -> ArrowState s (f x) m
foldS ArrowState s x m
a = ((s, f x) -> (s, m)) -> ArrowState s (f x) m
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m)) -> ArrowState s (f x) m)
-> ((s, f x) -> (s, m)) -> ArrowState s (f x) m
forall a b. (a -> b) -> a -> b
$ \(s
s,f x
f) -> (x -> (s, m) -> (s, m)) -> (s, m) -> f x -> (s, m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> (s, m) -> (s, m)
a' (s
s,m
forall a. Monoid a => a
mempty) f x
f
where a' :: x -> (s, m) -> (s, m)
a' x
x (s
s',m
m) = (m -> m) -> (s, m) -> (s, m)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
m) ((s, m) -> (s, m)) -> (s, m) -> (s, m)
forall a b. (a -> b) -> a -> b
$ ArrowState s x m -> (s, x) -> (s, m)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x m
a (s
s',x
x)
iterateS :: (Foldable f, MonadPlus m)
=> ArrowState s x y
-> ArrowState s (f x) (m y)
iterateS :: ArrowState s x y -> ArrowState s (f x) (m y)
iterateS ArrowState s x y
a = ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y))
-> ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall a b. (a -> b) -> a -> b
$ \(s
s,f x
f) -> (x -> (s, m y) -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> (s, m y) -> (s, m y)
forall (m :: * -> *). MonadPlus m => x -> (s, m y) -> (s, m y)
a' (s
s,m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
where a' :: x -> (s, m y) -> (s, m y)
a' x
x (s
s',m y
m) = (y -> m y) -> (s, y) -> (s, m y)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m(m y -> m y) -> (y -> m y) -> y -> m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return) ((s, y) -> (s, m y)) -> (s, y) -> (s, m y)
forall a b. (a -> b) -> a -> b
$ ArrowState s x y -> (s, x) -> (s, y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x y
a (s
s',x
x)
iterateSL :: (Foldable f, MonadPlus m)
=> ArrowState s x y
-> ArrowState s (f x) (m y)
iterateSL :: ArrowState s x y -> ArrowState s (f x) (m y)
iterateSL ArrowState s x y
a = ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y))
-> ((s, f x) -> (s, m y)) -> ArrowState s (f x) (m y)
forall a b. (a -> b) -> a -> b
$ \(s
s,f x
f) -> ((s, m y) -> x -> (s, m y)) -> (s, m y) -> f x -> (s, m y)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (s, m y) -> x -> (s, m y)
forall (m :: * -> *). MonadPlus m => (s, m y) -> x -> (s, m y)
a' (s
s,m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
where a' :: (s, m y) -> x -> (s, m y)
a' (s
s',m y
m) x
x = (y -> m y) -> (s, y) -> (s, m y)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m(m y -> m y) -> (y -> m y) -> y -> m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return) ((s, y) -> (s, m y)) -> (s, y) -> (s, m y)
forall a b. (a -> b) -> a -> b
$ ArrowState s x y -> (s, x) -> (s, y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x y
a (s
s',x
x)
iterateS' :: (Foldable f, MonadPlus m)
=> ArrowState s x (Either e y )
-> ArrowState s (f x) (Either e (m y))
iterateS' :: ArrowState s x (Either e y) -> ArrowState s (f x) (Either e (m y))
iterateS' ArrowState s x (Either e y)
a = ((s, f x) -> (s, Either e (m y)))
-> ArrowState s (f x) (Either e (m y))
forall state a b.
((state, a) -> (state, b)) -> ArrowState state a b
ArrowState (((s, f x) -> (s, Either e (m y)))
-> ArrowState s (f x) (Either e (m y)))
-> ((s, f x) -> (s, Either e (m y)))
-> ArrowState s (f x) (Either e (m y))
forall a b. (a -> b) -> a -> b
$ \(s
s,f x
f) -> (x -> (s, Either e (m y)) -> (s, Either e (m y)))
-> (s, Either e (m y)) -> f x -> (s, Either e (m y))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
forall (m :: * -> *).
MonadPlus m =>
s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
a' s
s) (s
s,m y -> Either e (m y)
forall a b. b -> Either a b
Right m y
forall (m :: * -> *) a. MonadPlus m => m a
mzero) f x
f
where a' :: s -> x -> (s, Either e (m y)) -> (s, Either e (m y))
a' s
s x
x (s
s',Right m y
m) = case ArrowState s x (Either e y) -> (s, x) -> (s, Either e y)
forall state a b. ArrowState state a b -> (state, a) -> (state, b)
runArrowState ArrowState s x (Either e y)
a (s
s',x
x) of
(s
s'',Right y
m') -> (s
s'',m y -> Either e (m y)
forall a b. b -> Either a b
Right (m y -> Either e (m y)) -> m y -> Either e (m y)
forall a b. (a -> b) -> a -> b
$ m y -> m y -> m y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m y
m (m y -> m y) -> m y -> m y
forall a b. (a -> b) -> a -> b
$ y -> m y
forall (m :: * -> *) a. Monad m => a -> m a
return y
m')
(s
_ ,Left e
e ) -> (s
s ,e -> Either e (m y)
forall a b. a -> Either a b
Left e
e )
a' s
_ x
_ (s, Either e (m y))
e = (s, Either e (m y))
e