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

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

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

       Implementation of pure list arrows with IO

    -}

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

    module Control.Arrow.IOListArrow
        ( IOLA(..)
        )
    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.DeepSeq
    import Control.Exception                ( SomeException
                                            , try
                                            )

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

    -- | list arrow combined with IO monad

    newtype IOLA a b = IOLA { IOLA a b -> a -> IO [b]
    runIOLA :: a -> IO [b] }

    instance Category IOLA where
        id :: IOLA a a
    id                  = (a -> IO [a]) -> IOLA a a
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((a -> IO [a]) -> IOLA a a) -> (a -> IO [a]) -> IOLA a a
    forall a b. (a -> b) -> a -> b
    $ [a] -> IO [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([a] -> IO [a]) -> (a -> [a]) -> a -> IO [a]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[])

        IOLA g :: b -> IO [c]
    g . :: IOLA b c -> IOLA a b -> IOLA a c
    . IOLA f :: a -> IO [b]
    f     = (a -> IO [c]) -> IOLA a c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((a -> IO [c]) -> IOLA a c) -> (a -> IO [c]) -> IOLA a c
    forall a b. (a -> b) -> a -> b
    $ \ x :: a
    x -> do
                                            [b]
    ys <- a -> IO [b]
    f a
    x
                                            [[c]]
    zs <- [IO [c]] -> IO [[c]]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence ([IO [c]] -> IO [[c]]) -> ([b] -> [IO [c]]) -> [b] -> IO [[c]]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (b -> IO [c]) -> [b] -> [IO [c]]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> IO [c]
    g ([b] -> IO [[c]]) -> [b] -> IO [[c]]
    forall a b. (a -> b) -> a -> b
    $ [b]
    ys
                                            [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[c]] -> [c]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[c]]
    zs)

    instance Arrow IOLA where
        arr :: (b -> c) -> IOLA b c
    arr f :: b -> c
    f               = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [b -> c
    f b
    x]

        first :: IOLA b c -> IOLA (b, d) (c, d)
    first (IOLA f :: b -> IO [c]
    f)      = ((b, d) -> IO [(c, d)]) -> IOLA (b, d) (c, d)
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA (((b, d) -> IO [(c, d)]) -> IOLA (b, d) (c, d))
    -> ((b, d) -> IO [(c, d)]) -> IOLA (b, d) (c, d)
    forall a b. (a -> b) -> a -> b
    $ \ ~(x1 :: b
    x1, x2 :: d
    x2) -> do
                                                    [c]
    ys1 <- b -> IO [c]
    f b
    x1
                                                    [(c, d)] -> IO [(c, d)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (c
    y1, d
    x2) | c
    y1 <- [c]
    ys1 ]

        -- just for efficiency
        second :: IOLA b c -> IOLA (d, b) (d, c)
    second (IOLA g :: b -> IO [c]
    g)     = ((d, b) -> IO [(d, c)]) -> IOLA (d, b) (d, c)
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA (((d, b) -> IO [(d, c)]) -> IOLA (d, b) (d, c))
    -> ((d, b) -> IO [(d, c)]) -> IOLA (d, b) (d, c)
    forall a b. (a -> b) -> a -> b
    $ \ ~(x1 :: d
    x1, x2 :: b
    x2) -> do
                                                    [c]
    ys2 <- b -> IO [c]
    g b
    x2
                                                    [(d, c)] -> IO [(d, c)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (d
    x1, c
    y2) | c
    y2 <- [c]
    ys2 ]

        -- just for efficiency
        IOLA f :: b -> IO [c]
    f *** :: IOLA b c -> IOLA b' c' -> IOLA (b, b') (c, c')
    *** IOLA g :: b' -> IO [c']
    g   = ((b, b') -> IO [(c, c')]) -> IOLA (b, b') (c, c')
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA (((b, b') -> IO [(c, c')]) -> IOLA (b, b') (c, c'))
    -> ((b, b') -> IO [(c, c')]) -> IOLA (b, b') (c, c')
    forall a b. (a -> b) -> a -> b
    $ \ ~(x1 :: b
    x1, x2 :: b'
    x2) -> do
                                                    [c]
    ys1 <- b -> IO [c]
    f b
    x1
                                                    [c']
    ys2 <- b' -> IO [c']
    g b'
    x2
                                                    [(c, c')] -> IO [(c, c')]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (c
    y1, c'
    y2) | c
    y1 <- [c]
    ys1, c'
    y2 <- [c']
    ys2 ]

        -- just for efficiency
        IOLA f :: b -> IO [c]
    f &&& :: IOLA b c -> IOLA b c' -> IOLA b (c, c')
    &&& IOLA g :: b -> IO [c']
    g   = (b -> IO [(c, c')]) -> IOLA b (c, c')
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [(c, c')]) -> IOLA b (c, c'))
    -> (b -> IO [(c, c')]) -> IOLA b (c, c')
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> do
                                            [c]
    ys1 <- b -> IO [c]
    f b
    x
                                            [c']
    ys2 <- b -> IO [c']
    g b
    x
                                            [(c, c')] -> IO [(c, c')]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (c
    y1, c'
    y2) | c
    y1 <- [c]
    ys1, c'
    y2 <- [c']
    ys2 ]

    instance ArrowZero IOLA where
        zeroArrow :: IOLA b c
    zeroArrow           = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ IO [c] -> b -> IO [c]
    forall a b. a -> b -> a
    const ([c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [])

    instance ArrowPlus IOLA where
        IOLA f :: b -> IO [c]
    f <+> :: IOLA b c -> IOLA b c -> IOLA b c
    <+> IOLA g :: b -> IO [c]
    g   = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> do
                                            [c]
    rs1 <- b -> IO [c]
    f b
    x
                                            [c]
    rs2 <- b -> IO [c]
    g b
    x
                                            [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([c]
    rs1 [c] -> [c] -> [c]
    forall a. [a] -> [a] -> [a]
    ++ [c]
    rs2)

    instance ArrowChoice IOLA where
        left :: IOLA b c -> IOLA (Either b d) (Either c d)
    left (IOLA f :: b -> IO [c]
    f)       = (Either b d -> IO [Either c d]) -> IOLA (Either b d) (Either c d)
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((Either b d -> IO [Either c d]) -> IOLA (Either b d) (Either c d))
    -> (Either b d -> IO [Either c d])
    -> IOLA (Either b d) (Either c d)
    forall a b. (a -> b) -> a -> b
    $ (b -> IO [Either c d])
    -> (d -> IO [Either c d]) -> Either b d -> IO [Either c d]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either
                                       (\ x :: b
    x -> b -> IO [c]
    f b
    x IO [c] -> ([c] -> IO [Either c d]) -> IO [Either c d]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\ y :: [c]
    y -> [Either c d] -> IO [Either c d]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((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)))
                                       ([Either c d] -> IO [Either c d]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Either c d] -> IO [Either c d])
    -> (d -> [Either c d]) -> d -> IO [Either c d]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Either c d -> [Either c d] -> [Either c d]
    forall a. a -> [a] -> [a]
    :[]) (Either c d -> [Either c d])
    -> (d -> Either c d) -> d -> [Either c d]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . d -> Either c d
    forall a b. b -> Either a b
    Right)
        right :: IOLA b c -> IOLA (Either d b) (Either d c)
    right (IOLA f :: b -> IO [c]
    f)      = (Either d b -> IO [Either d c]) -> IOLA (Either d b) (Either d c)
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((Either d b -> IO [Either d c]) -> IOLA (Either d b) (Either d c))
    -> (Either d b -> IO [Either d c])
    -> IOLA (Either d b) (Either d c)
    forall a b. (a -> b) -> a -> b
    $ (d -> IO [Either d c])
    -> (b -> IO [Either d c]) -> Either d b -> IO [Either d c]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either
                                       ([Either d c] -> IO [Either d c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Either d c] -> IO [Either d c])
    -> (d -> [Either d c]) -> d -> IO [Either d c]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Either d c -> [Either d c] -> [Either d c]
    forall a. a -> [a] -> [a]
    :[]) (Either d c -> [Either d c])
    -> (d -> Either d c) -> d -> [Either d c]
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . d -> Either d c
    forall a b. a -> Either a b
    Left)
                                       (\ x :: b
    x -> b -> IO [c]
    f b
    x IO [c] -> ([c] -> IO [Either d c]) -> IO [Either d c]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\ y :: [c]
    y -> [Either d c] -> IO [Either d c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((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 IOLA where
        app :: IOLA (IOLA b c, b) c
    app                 = ((IOLA b c, b) -> IO [c]) -> IOLA (IOLA b c, b) c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA (((IOLA b c, b) -> IO [c]) -> IOLA (IOLA b c, b) c)
    -> ((IOLA b c, b) -> IO [c]) -> IOLA (IOLA b c, b) c
    forall a b. (a -> b) -> a -> b
    $ \ (IOLA f :: b -> IO [c]
    f, x :: b
    x) -> b -> IO [c]
    f b
    x

    instance ArrowList IOLA where
        arrL :: (b -> [c]) -> IOLA b c
    arrL f :: b -> [c]
    f              = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> [c]
    f b
    x)
        arr2A :: (b -> IOLA c d) -> IOLA (b, c) d
    arr2A f :: b -> IOLA c d
    f             = ((b, c) -> IO [d]) -> IOLA (b, c) d
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA (((b, c) -> IO [d]) -> IOLA (b, c) d)
    -> ((b, c) -> IO [d]) -> IOLA (b, c) d
    forall a b. (a -> b) -> a -> b
    $ \ ~(x :: b
    x, y :: c
    y) -> IOLA c d -> c -> IO [d]
    forall a b. IOLA a b -> a -> IO [b]
    runIOLA (b -> IOLA c d
    f b
    x) c
    y
        constA :: c -> IOLA b c
    constA c :: c
    c            = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ IO [c] -> b -> IO [c]
    forall a b. a -> b -> a
    const ([c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [c
    c])
        isA :: (b -> Bool) -> IOLA b b
    isA p :: b -> Bool
    p               = (b -> IO [b]) -> IOLA b b
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [b]) -> IOLA b b) -> (b -> IO [b]) -> IOLA b b
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> [b] -> IO [b]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (if b -> Bool
    p b
    x then [b
    x] else [])
        IOLA f :: b -> IO [c]
    f >>. :: IOLA b c -> ([c] -> [d]) -> IOLA b d
    >>. g :: [c] -> [d]
    g        = (b -> IO [d]) -> IOLA b d
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [d]) -> IOLA b d) -> (b -> IO [d]) -> IOLA b d
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> do
                                           [c]
    ys <- b -> IO [c]
    f b
    x
                                           [d] -> IO [d]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([c] -> [d]
    g [c]
    ys)

    instance ArrowIf IOLA where
        ifA :: IOLA b c -> IOLA b d -> IOLA b d -> IOLA b d
    ifA (IOLA p :: b -> IO [c]
    p) ta :: IOLA b d
    ta ea :: IOLA b d
    ea  = (b -> IO [d]) -> IOLA b d
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [d]) -> IOLA b d) -> (b -> IO [d]) -> IOLA b d
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> do
                                           [c]
    res <- b -> IO [c]
    p b
    x
                                           IOLA b d -> b -> IO [d]
    forall a b. IOLA a b -> a -> IO [b]
    runIOLA (if [c] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [c]
    res then IOLA b d
    ea else IOLA b d
    ta) b
    x
        (IOLA f :: b -> IO [c]
    f) orElse :: IOLA b c -> IOLA b c -> IOLA b c
    `orElse` g :: IOLA b c
    g
                            = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> do
                                           [c]
    res <- b -> IO [c]
    f b
    x
                                           if [c] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [c]
    res then IOLA b c -> b -> IO [c]
    forall a b. IOLA a b -> a -> IO [b]
    runIOLA IOLA b c
    g b
    x else [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [c]
    res

    instance ArrowIO IOLA where
        arrIO :: (b -> IO c) -> IOLA b c
    arrIO cmd :: b -> IO c
    cmd           = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> do
                                           c
    res <- b -> IO c
    cmd b
    x
                                           [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [c
    res]

    instance ArrowExc IOLA where
        tryA :: IOLA b c -> IOLA b (Either SomeException c)
    tryA f :: IOLA b c
    f              = (b -> IO [Either SomeException c])
    -> IOLA b (Either SomeException c)
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [Either SomeException c])
     -> IOLA b (Either SomeException c))
    -> (b -> IO [Either SomeException c])
    -> IOLA b (Either SomeException c)
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> do
                                            Either SomeException [c]
    res <- IO [c] -> IO (Either SomeException [c])
    forall a. IO a -> IO (Either SomeException a)
    try' (IO [c] -> IO (Either SomeException [c]))
    -> IO [c] -> IO (Either SomeException [c])
    forall a b. (a -> b) -> a -> b
    $ IOLA b c -> b -> IO [c]
    forall a b. IOLA a b -> a -> IO [b]
    runIOLA IOLA b c
    f b
    x
                                            [Either SomeException c] -> IO [Either SomeException c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Either SomeException c] -> IO [Either SomeException c])
    -> [Either SomeException c] -> IO [Either SomeException c]
    forall a b. (a -> b) -> a -> b
    $
                                              case Either SomeException [c]
    res of
                                              Left  er :: SomeException
    er -> [SomeException -> Either SomeException c
    forall a b. a -> Either a b
    Left SomeException
    er]
                                              Right ys :: [c]
    ys -> [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 IOLA where
        isIOA :: (b -> IO Bool) -> IOLA b b
    isIOA p :: b -> IO Bool
    p             = (b -> IO [b]) -> IOLA b b
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [b]) -> IOLA b b) -> (b -> IO [b]) -> IOLA b b
    forall a b. (a -> b) -> a -> b
    $ \x :: b
    x -> do
                                           Bool
    res <- b -> IO Bool
    p b
    x
                                           [b] -> IO [b]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (if Bool
    res then [b
    x] else [])

    instance ArrowTree IOLA

    instance ArrowNavigatableTree IOLA

    instance ArrowNF IOLA where
        rnfA :: IOLA b c -> IOLA b c
    rnfA (IOLA f :: b -> IO [c]
    f)       = (b -> IO [c]) -> IOLA b c
    forall a b. (a -> IO [b]) -> IOLA a b
    IOLA ((b -> IO [c]) -> IOLA b c) -> (b -> IO [c]) -> IOLA b c
    forall a b. (a -> b) -> a -> b
    $ \ x :: b
    x -> do
                                            [c]
    res <- b -> IO [c]
    f b
    x
                                            [c]
    res [c] -> IO [c] -> IO [c]
    forall a b. NFData a => a -> b -> b
    `deepseq` [c] -> IO [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [c]
    res

    instance ArrowWNF IOLA

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