{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

-- ------------------------------------------------------------

{- |
   Module     : Control.Arrow.IOStateListArrow
   Copyright  : Copyright (C) 2005-8 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   Implementation of arrows with IO and a state

-}

-- ------------------------------------------------------------

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
                                        )
{-
import qualified Debug.Trace as T
-}
-- ------------------------------------------------------------

-- | list arrow combined with a state and the IO monad

newtype IOSLA s a b = IOSLA { forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
runIOSLA :: s -> a -> IO (s, [b]) }

instance Category (IOSLA s) where
    id :: forall a. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [a
x])      -- don't defined id = arr id, this gives loops during optimization
    {-# INLINE id #-}

    IOSLA s -> b -> IO (s, [c])
g . :: forall b c a. 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
                                           (s1, ys) <- s -> a -> IO (s, [b])
f s
s a
x
                                           sequence' s1 ys
                                           where
                                           sequence' :: s -> [b] -> IO (s, [c])
sequence' s
s' []       = (s, [c]) -> IO (s, [c])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', [])
                                           sequence' s
s' (b
x':[b]
xs') = do
                                                                   (s1', ys') <- s -> b -> IO (s, [c])
g s
s' b
x'
                                                                   (s2', zs') <- sequence' s1' xs'
                                                                   return (s2', ys' ++ zs')

instance Arrow (IOSLA s) where
    arr :: forall b c. (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [b -> c
f b
x])
    {-# INLINE arr #-}

    first :: forall b c d. 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', ys1) <- s -> b -> IO (s, [c])
f s
s b
x1
                                                   return (s', [ (y1, x2) | y1 <- ys1 ])

    -- just for efficiency
    second :: forall b c d. 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', ys2) <- s -> b -> IO (s, [c])
g s
s b
x2
                                                  return (s', [ (x1, y2) | y2 <- ys2 ])

    -- just for efficiency
    IOSLA s -> b -> IO (s, [c])
f *** :: forall b c b' c'.
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
                                                   (s1, ys1) <- s -> b -> IO (s, [c])
f s
s  b
x1
                                                   (s2, ys2) <- g s1 x2
                                                   return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])

    -- just for efficiency
    IOSLA s -> b -> IO (s, [c])
f &&& :: forall b c c'. 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
                                           (s1, ys1) <- s -> b -> IO (s, [c])
f s
s  b
x
                                           (s2, ys2) <- g s1 x
                                           return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])



instance ArrowZero (IOSLA s) where
    zeroArrow :: forall b c. 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 a. a -> IO a
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 <+> :: forall b c. 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
                                           (s1, rs1) <- s -> b -> IO (s, [c])
f s
s  b
x
                                           (s2, rs2) <- g s1 x
                                           return (s2, rs1 ++ rs2)

instance ArrowChoice (IOSLA s) where
    left :: forall b c d. 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
                                                 (s1, y) <- s -> b -> IO (s, [c])
f s
s b
x
                                                 return (s1, map Left y)
                                         )
                                         (\ d
x -> (s, [Either c d]) -> IO (s, [Either c d])
forall a. a -> IO a
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 :: forall b c d. 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 a. a -> IO a
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
                                                 (s1, y) <- s -> b -> IO (s, [c])
f s
s b
x
                                                 return (s1, map Right y)
                                         )

instance ArrowApply (IOSLA s) where
    app :: forall b c. 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 :: forall b c. (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, (b -> [c]
f b
x))
    {-# INLINE arrL #-}
    arr2A :: forall b c d. (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 :: forall c b. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [c
c]))
    {-# INLINE constA #-}
    isA :: forall b. (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 a. a -> IO a
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 >>. :: forall b c d. 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
                                           (s1, ys) <- s -> b -> IO (s, [c])
f s
s b
x
                                           return (s1, g ys)
    {-# INLINE (>>.) #-}

    -- just for efficency
    perform :: forall b c. 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
                                           (s1, _ys) <- s -> b -> IO (s, [c])
f s
s b
x
                                           return (s1, [x])
    {-# INLINE perform #-}

instance ArrowIf (IOSLA s) where
    ifA :: forall b c d.
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
                                           (s1, res) <- s -> b -> IO (s, [c])
p s
s b
x
                                           runIOSLA ( if null res
                                                      then ea
                                                      else ta
                                                    ) s1 x

    (IOSLA s -> b -> IO (s, [c])
f) orElse :: forall b c. 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@(s1, res) <- s -> b -> IO (s, [c])
f s
s b
x
                                           if null res
                                              then runIOSLA g s1 x
                                              else return r


instance ArrowIO (IOSLA s) where
    arrIO :: forall b c. (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
                                           res <- b -> IO c
cmd b
x
                                           return (s, [res])
    {-# INLINE arrIO #-}

instance ArrowExc (IOSLA s) where
    tryA :: forall b c. 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
                                           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
                                           return $ case 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' :: forall a. 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 :: forall b. (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
                                           res <- b -> IO Bool
p b
x
                                           return (s, if res then [x] else [])
    {-# INLINE isIOA #-}

instance ArrowState s (IOSLA s) where
    changeState :: forall b. (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> s
forall a b. a -> b -> b
seq s
s' s
s', [b
x])
    {-# INLINE changeState #-}
    accessState :: forall b c. (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, [s -> b -> c
af s
s b
x])
    {-# INLINE accessState #-}

-- ------------------------------------------------------------

-- |
-- lift the state of an IOSLA arrow to a state with an additional component.
--
-- This is uesful, when running predefined IO arrows, e.g. for document input,
-- in a context with a more complex state component.

liftSt          :: IOSLA s1 b c -> IOSLA (s1, s2) b c
liftSt :: forall s1 b c s2. 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', ys) <- s1 -> b -> IO (s1, [c])
f s1
s1 b
x
                              return ((s1', s2), ys)


-- |
-- run an arrow with augmented state in the context of a simple state arrow.
-- An initial value for the new state component is needed.
--
-- This is useful, when running an arrow with an extra environment component, e.g.
-- for namespace handling in XML.

runSt           :: s2 -> IOSLA (s1, s2) b c -> IOSLA s1 b c
runSt :: forall s2 s1 b c. 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', _s2'), ys) <- (s1, s2) -> b -> IO ((s1, s2), [c])
f (s1
s1, s2
s2) b
x
                        return (s1', ys)

-- ------------------------------------------------------------

instance ArrowTree (IOSLA s)

instance ArrowNavigatableTree (IOSLA s)

instance ArrowNF (IOSLA s) where
    rnfA :: forall c b. NFData c => 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
                                           res <- s -> b -> IO (s, [c])
f s
s b
x
                                           ( -- T.trace "start rnfA for IOSLA" $
                                             snd res
                                             )
                                             `deepseq`
                                              return ( -- T.trace "end rnfA for IOSLA" $
                                                       res
                                                     )

instance ArrowWNF (IOSLA s)

-- ------------------------------------------------------------