    {-# 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)

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