{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Control.Arrow.IOStateListArrow
( IOSLA(..)
, liftSt
, runSt
)
where
import Prelude hiding (id, (.))
import Control.Category
import Control.Arrow
import Control.Arrow.ArrowExc
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowIO
import Control.Arrow.ArrowList
import Control.Arrow.ArrowNF
import Control.Arrow.ArrowTree
import Control.Arrow.ArrowNavigatableTree
import Control.Arrow.ArrowState
import Control.DeepSeq
import Control.Exception ( SomeException
, try
)
newtype IOSLA s a b = IOSLA { IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA :: s -> a -> IO (s, [b]) }
instance Category (IOSLA s) where
id :: IOSLA s a a
id = (s -> a -> IO (s, [a])) -> IOSLA s a a
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> a -> IO (s, [a])) -> IOSLA s a a)
-> (s -> a -> IO (s, [a])) -> IOSLA s a a
forall a b. (a -> b) -> a -> b
$ \ s
s a
x -> (s, [a]) -> IO (s, [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [a
x])
{-# INLINE id #-}
IOSLA s -> b -> IO (s, [c])
g . :: IOSLA s b c -> IOSLA s a b -> IOSLA s a c
. IOSLA s -> a -> IO (s, [b])
f = (s -> a -> IO (s, [c])) -> IOSLA s a c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> a -> IO (s, [c])) -> IOSLA s a c)
-> (s -> a -> IO (s, [c])) -> IOSLA s a c
forall a b. (a -> b) -> a -> b
$ \ s
s a
x -> do
(s
s1, [b]
ys) <- s -> a -> IO (s, [b])
f s
s a
x
s -> [b] -> IO (s, [c])
sequence' s
s1 [b]
ys
where
sequence' :: s -> [b] -> IO (s, [c])
sequence' s
s' [] = (s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', [])
sequence' s
s' (b
x':[b]
xs') = do
(s
s1', [c]
ys') <- s -> b -> IO (s, [c])
g s
s' b
x'
(s
s2', [c]
zs') <- s -> [b] -> IO (s, [c])
sequence' s
s1' [b]
xs'
(s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s2', [c]
ys' [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
zs')
instance Arrow (IOSLA s) where
arr :: (b -> c) -> IOSLA s b c
arr b -> c
f = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> (s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [b -> c
f b
x])
{-# INLINE arr #-}
first :: IOSLA s b c -> IOSLA s (b, d) (c, d)
first (IOSLA s -> b -> IO (s, [c])
f) = (s -> (b, d) -> IO (s, [(c, d)])) -> IOSLA s (b, d) (c, d)
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> (b, d) -> IO (s, [(c, d)])) -> IOSLA s (b, d) (c, d))
-> (s -> (b, d) -> IO (s, [(c, d)])) -> IOSLA s (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \ s
s (b
x1, d
x2) -> do
(s
s', [c]
ys1) <- s -> b -> IO (s, [c])
f s
s b
x1
(s, [(c, d)]) -> IO (s, [(c, d)])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', [ (c
y1, d
x2) | c
y1 <- [c]
ys1 ])
second :: IOSLA s b c -> IOSLA s (d, b) (d, c)
second (IOSLA s -> b -> IO (s, [c])
g) = (s -> (d, b) -> IO (s, [(d, c)])) -> IOSLA s (d, b) (d, c)
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> (d, b) -> IO (s, [(d, c)])) -> IOSLA s (d, b) (d, c))
-> (s -> (d, b) -> IO (s, [(d, c)])) -> IOSLA s (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ \ s
s (d
x1, b
x2) -> do
(s
s', [c]
ys2) <- s -> b -> IO (s, [c])
g s
s b
x2
(s, [(d, c)]) -> IO (s, [(d, c)])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', [ (d
x1, c
y2) | c
y2 <- [c]
ys2 ])
IOSLA s -> b -> IO (s, [c])
f *** :: IOSLA s b c -> IOSLA s b' c' -> IOSLA s (b, b') (c, c')
*** IOSLA s -> b' -> IO (s, [c'])
g = (s -> (b, b') -> IO (s, [(c, c')])) -> IOSLA s (b, b') (c, c')
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> (b, b') -> IO (s, [(c, c')])) -> IOSLA s (b, b') (c, c'))
-> (s -> (b, b') -> IO (s, [(c, c')])) -> IOSLA s (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ \ s
s (b
x1, b'
x2) -> do
(s
s1, [c]
ys1) <- s -> b -> IO (s, [c])
f s
s b
x1
(s
s2, [c']
ys2) <- s -> b' -> IO (s, [c'])
g s
s1 b'
x2
(s, [(c, c')]) -> IO (s, [(c, c')])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s2, [ (c
y1, c'
y2) | c
y1 <- [c]
ys1, c'
y2 <- [c']
ys2 ])
IOSLA s -> b -> IO (s, [c])
f &&& :: IOSLA s b c -> IOSLA s b c' -> IOSLA s b (c, c')
&&& IOSLA s -> b -> IO (s, [c'])
g = (s -> b -> IO (s, [(c, c')])) -> IOSLA s b (c, c')
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [(c, c')])) -> IOSLA s b (c, c'))
-> (s -> b -> IO (s, [(c, c')])) -> IOSLA s b (c, c')
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s
s1, [c]
ys1) <- s -> b -> IO (s, [c])
f s
s b
x
(s
s2, [c']
ys2) <- s -> b -> IO (s, [c'])
g s
s1 b
x
(s, [(c, c')]) -> IO (s, [(c, c')])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s2, [ (c
y1, c'
y2) | c
y1 <- [c]
ys1, c'
y2 <- [c']
ys2 ])
instance ArrowZero (IOSLA s) where
zeroArrow :: IOSLA s b c
zeroArrow = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s -> IO (s, [c]) -> b -> IO (s, [c])
forall a b. a -> b -> a
const ((s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, []))
{-# INLINE zeroArrow #-}
instance ArrowPlus (IOSLA s) where
IOSLA s -> b -> IO (s, [c])
f <+> :: IOSLA s b c -> IOSLA s b c -> IOSLA s b c
<+> IOSLA s -> b -> IO (s, [c])
g = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s
s1, [c]
rs1) <- s -> b -> IO (s, [c])
f s
s b
x
(s
s2, [c]
rs2) <- s -> b -> IO (s, [c])
g s
s1 b
x
(s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s2, [c]
rs1 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
rs2)
instance ArrowChoice (IOSLA s) where
left :: IOSLA s b c -> IOSLA s (Either b d) (Either c d)
left (IOSLA s -> b -> IO (s, [c])
f) = (s -> Either b d -> IO (s, [Either c d]))
-> IOSLA s (Either b d) (Either c d)
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> Either b d -> IO (s, [Either c d]))
-> IOSLA s (Either b d) (Either c d))
-> (s -> Either b d -> IO (s, [Either c d]))
-> IOSLA s (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ \ s
s -> (b -> IO (s, [Either c d]))
-> (d -> IO (s, [Either c d]))
-> Either b d
-> IO (s, [Either c d])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ b
x -> do
(s
s1, [c]
y) <- s -> b -> IO (s, [c])
f s
s b
x
(s, [Either c d]) -> IO (s, [Either c d])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s1, (c -> Either c d) -> [c] -> [Either c d]
forall a b. (a -> b) -> [a] -> [b]
map c -> Either c d
forall a b. a -> Either a b
Left [c]
y)
)
(\ d
x -> (s, [Either c d]) -> IO (s, [Either c d])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [d -> Either c d
forall a b. b -> Either a b
Right d
x]))
right :: IOSLA s b c -> IOSLA s (Either d b) (Either d c)
right (IOSLA s -> b -> IO (s, [c])
f) = (s -> Either d b -> IO (s, [Either d c]))
-> IOSLA s (Either d b) (Either d c)
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> Either d b -> IO (s, [Either d c]))
-> IOSLA s (Either d b) (Either d c))
-> (s -> Either d b -> IO (s, [Either d c]))
-> IOSLA s (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$ \ s
s -> (d -> IO (s, [Either d c]))
-> (b -> IO (s, [Either d c]))
-> Either d b
-> IO (s, [Either d c])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ d
x -> (s, [Either d c]) -> IO (s, [Either d c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [d -> Either d c
forall a b. a -> Either a b
Left d
x]))
(\ b
x -> do
(s
s1, [c]
y) <- s -> b -> IO (s, [c])
f s
s b
x
(s, [Either d c]) -> IO (s, [Either d c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s1, (c -> Either d c) -> [c] -> [Either d c]
forall a b. (a -> b) -> [a] -> [b]
map c -> Either d c
forall a b. b -> Either a b
Right [c]
y)
)
instance ArrowApply (IOSLA s) where
app :: IOSLA s (IOSLA s b c, b) c
app = (s -> (IOSLA s b c, b) -> IO (s, [c]))
-> IOSLA s (IOSLA s b c, b) c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> (IOSLA s b c, b) -> IO (s, [c]))
-> IOSLA s (IOSLA s b c, b) c)
-> (s -> (IOSLA s b c, b) -> IO (s, [c]))
-> IOSLA s (IOSLA s b c, b) c
forall a b. (a -> b) -> a -> b
$ \ s
s (IOSLA s -> b -> IO (s, [c])
f, b
x) -> s -> b -> IO (s, [c])
f s
s b
x
{-# INLINE app #-}
instance ArrowList (IOSLA s) where
arrL :: (b -> [c]) -> IOSLA s b c
arrL b -> [c]
f = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> (s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, (b -> [c]
f b
x))
{-# INLINE arrL #-}
arr2A :: (b -> IOSLA s c d) -> IOSLA s (b, c) d
arr2A b -> IOSLA s c d
f = (s -> (b, c) -> IO (s, [d])) -> IOSLA s (b, c) d
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> (b, c) -> IO (s, [d])) -> IOSLA s (b, c) d)
-> (s -> (b, c) -> IO (s, [d])) -> IOSLA s (b, c) d
forall a b. (a -> b) -> a -> b
$ \ s
s (b
x, c
y) -> IOSLA s c d -> s -> c -> IO (s, [d])
forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA (b -> IOSLA s c d
f b
x) s
s c
y
{-# INLINE arr2A #-}
constA :: c -> IOSLA s b c
constA c
c = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s -> IO (s, [c]) -> b -> IO (s, [c])
forall a b. a -> b -> a
const ((s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [c
c]))
{-# INLINE constA #-}
isA :: (b -> Bool) -> IOSLA s b b
isA b -> Bool
p = (s -> b -> IO (s, [b])) -> IOSLA s b b
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [b])) -> IOSLA s b b)
-> (s -> b -> IO (s, [b])) -> IOSLA s b b
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> (s, [b]) -> IO (s, [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, if b -> Bool
p b
x then [b
x] else [])
{-# INLINE isA #-}
IOSLA s -> b -> IO (s, [c])
f >>. :: IOSLA s b c -> ([c] -> [d]) -> IOSLA s b d
>>. [c] -> [d]
g = (s -> b -> IO (s, [d])) -> IOSLA s b d
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [d])) -> IOSLA s b d)
-> (s -> b -> IO (s, [d])) -> IOSLA s b d
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s
s1, [c]
ys) <- s -> b -> IO (s, [c])
f s
s b
x
(s, [d]) -> IO (s, [d])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s1, [c] -> [d]
g [c]
ys)
{-# INLINE (>>.) #-}
perform :: IOSLA s b c -> IOSLA s b b
perform (IOSLA s -> b -> IO (s, [c])
f) = (s -> b -> IO (s, [b])) -> IOSLA s b b
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [b])) -> IOSLA s b b)
-> (s -> b -> IO (s, [b])) -> IOSLA s b b
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s
s1, [c]
_ys) <- s -> b -> IO (s, [c])
f s
s b
x
(s, [b]) -> IO (s, [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s1, [b
x])
{-# INLINE perform #-}
instance ArrowIf (IOSLA s) where
ifA :: IOSLA s b c -> IOSLA s b d -> IOSLA s b d -> IOSLA s b d
ifA (IOSLA s -> b -> IO (s, [c])
p) IOSLA s b d
ta IOSLA s b d
ea = (s -> b -> IO (s, [d])) -> IOSLA s b d
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [d])) -> IOSLA s b d)
-> (s -> b -> IO (s, [d])) -> IOSLA s b d
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s
s1, [c]
res) <- s -> b -> IO (s, [c])
p s
s b
x
IOSLA s b d -> s -> b -> IO (s, [d])
forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA ( if [c] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
res
then IOSLA s b d
ea
else IOSLA s b d
ta
) s
s1 b
x
(IOSLA s -> b -> IO (s, [c])
f) orElse :: IOSLA s b c -> IOSLA s b c -> IOSLA s b c
`orElse` IOSLA s b c
g
= (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
r :: (s, [c])
r@(s
s1, [c]
res) <- s -> b -> IO (s, [c])
f s
s b
x
if [c] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
res
then IOSLA s b c -> s -> b -> IO (s, [c])
forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA IOSLA s b c
g s
s1 b
x
else (s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s, [c])
r
instance ArrowIO (IOSLA s) where
arrIO :: (b -> IO c) -> IOSLA s b c
arrIO b -> IO c
cmd = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
c
res <- b -> IO c
cmd b
x
(s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [c
res])
{-# INLINE arrIO #-}
instance ArrowExc (IOSLA s) where
tryA :: IOSLA s b c -> IOSLA s b (Either SomeException c)
tryA IOSLA s b c
f = (s -> b -> IO (s, [Either SomeException c]))
-> IOSLA s b (Either SomeException c)
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [Either SomeException c]))
-> IOSLA s b (Either SomeException c))
-> (s -> b -> IO (s, [Either SomeException c]))
-> IOSLA s b (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
Either SomeException (s, [c])
res <- IO (s, [c]) -> IO (Either SomeException (s, [c]))
forall a. IO a -> IO (Either SomeException a)
try' (IO (s, [c]) -> IO (Either SomeException (s, [c])))
-> IO (s, [c]) -> IO (Either SomeException (s, [c]))
forall a b. (a -> b) -> a -> b
$ IOSLA s b c -> s -> b -> IO (s, [c])
forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA IOSLA s b c
f s
s b
x
(s, [Either SomeException c]) -> IO (s, [Either SomeException c])
forall (m :: * -> *) a. Monad m => a -> m a
return ((s, [Either SomeException c]) -> IO (s, [Either SomeException c]))
-> (s, [Either SomeException c])
-> IO (s, [Either SomeException c])
forall a b. (a -> b) -> a -> b
$ case Either SomeException (s, [c])
res of
Left SomeException
er -> (s
s, [SomeException -> Either SomeException c
forall a b. a -> Either a b
Left SomeException
er])
Right (s
s1, [c]
ys) -> (s
s1, [c -> Either SomeException c
forall a b. b -> Either a b
Right c
x' | c
x' <- [c]
ys])
where
try' :: IO a -> IO (Either SomeException a)
try' :: IO a -> IO (Either SomeException a)
try' = IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try
instance ArrowIOIf (IOSLA s) where
isIOA :: (b -> IO Bool) -> IOSLA s b b
isIOA b -> IO Bool
p = (s -> b -> IO (s, [b])) -> IOSLA s b b
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [b])) -> IOSLA s b b)
-> (s -> b -> IO (s, [b])) -> IOSLA s b b
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
Bool
res <- b -> IO Bool
p b
x
(s, [b]) -> IO (s, [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, if Bool
res then [b
x] else [])
{-# INLINE isIOA #-}
instance ArrowState s (IOSLA s) where
changeState :: (s -> b -> s) -> IOSLA s b b
changeState s -> b -> s
cf = (s -> b -> IO (s, [b])) -> IOSLA s b b
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [b])) -> IOSLA s b b)
-> (s -> b -> IO (s, [b])) -> IOSLA s b b
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> let s' :: s
s' = s -> b -> s
cf s
s b
x in (s, [b]) -> IO (s, [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> s
seq s
s' s
s', [b
x])
{-# INLINE changeState #-}
accessState :: (s -> b -> c) -> IOSLA s b c
accessState s -> b -> c
af = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> (s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [s -> b -> c
af s
s b
x])
{-# INLINE accessState #-}
liftSt :: IOSLA s1 b c -> IOSLA (s1, s2) b c
liftSt :: IOSLA s1 b c -> IOSLA (s1, s2) b c
liftSt (IOSLA s1 -> b -> IO (s1, [c])
f)
= ((s1, s2) -> b -> IO ((s1, s2), [c])) -> IOSLA (s1, s2) b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA (((s1, s2) -> b -> IO ((s1, s2), [c])) -> IOSLA (s1, s2) b c)
-> ((s1, s2) -> b -> IO ((s1, s2), [c])) -> IOSLA (s1, s2) b c
forall a b. (a -> b) -> a -> b
$ \ (s1
s1, s2
s2) b
x -> do
(s1
s1', [c]
ys) <- s1 -> b -> IO (s1, [c])
f s1
s1 b
x
((s1, s2), [c]) -> IO ((s1, s2), [c])
forall (m :: * -> *) a. Monad m => a -> m a
return ((s1
s1', s2
s2), [c]
ys)
runSt :: s2 -> IOSLA (s1, s2) b c -> IOSLA s1 b c
runSt :: s2 -> IOSLA (s1, s2) b c -> IOSLA s1 b c
runSt s2
s2 (IOSLA (s1, s2) -> b -> IO ((s1, s2), [c])
f)
= (s1 -> b -> IO (s1, [c])) -> IOSLA s1 b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s1 -> b -> IO (s1, [c])) -> IOSLA s1 b c)
-> (s1 -> b -> IO (s1, [c])) -> IOSLA s1 b c
forall a b. (a -> b) -> a -> b
$ \ s1
s1 b
x -> do
((s1
s1', s2
_s2'), [c]
ys) <- (s1, s2) -> b -> IO ((s1, s2), [c])
f (s1
s1, s2
s2) b
x
(s1, [c]) -> IO (s1, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (s1
s1', [c]
ys)
instance ArrowTree (IOSLA s)
instance ArrowNavigatableTree (IOSLA s)
instance ArrowNF (IOSLA s) where
rnfA :: IOSLA s b c -> IOSLA s b c
rnfA (IOSLA s -> b -> IO (s, [c])
f) = (s -> b -> IO (s, [c])) -> IOSLA s b c
forall s a b. (s -> a -> IO (s, [b])) -> IOSLA s a b
IOSLA ((s -> b -> IO (s, [c])) -> IOSLA s b c)
-> (s -> b -> IO (s, [c])) -> IOSLA s b c
forall a b. (a -> b) -> a -> b
$ \ s
s b
x -> do
(s, [c])
res <- s -> b -> IO (s, [c])
f s
s b
x
(
(s, [c]) -> [c]
forall a b. (a, b) -> b
snd (s, [c])
res
)
[c] -> IO (s, [c]) -> IO (s, [c])
forall a b. NFData a => a -> b -> b
`deepseq`
(s, [c]) -> IO (s, [c])
forall (m :: * -> *) a. Monad m => a -> m a
return (
(s, [c])
res
)
instance ArrowWNF (IOSLA s)