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
)
newtype IOLA a b = IOLA { forall a b. IOLA a b -> a -> IO [b]
runIOLA :: a -> IO [b] }
instance Category IOLA where
id :: forall a. IOLA a a
id = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. a -> [a] -> [a]
:[])
IOLA b -> IO [c]
g . :: forall b c a. IOLA b c -> IOLA a b -> IOLA a c
. IOLA a -> IO [b]
f = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ a
x -> do
[b]
ys <- a -> IO [b]
f a
x
[[c]]
zs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a -> b) -> [a] -> [b]
map b -> IO [c]
g forall a b. (a -> b) -> a -> b
$ [b]
ys
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[c]]
zs)
instance Arrow IOLA where
arr :: forall b c. (b -> c) -> IOLA b c
arr b -> c
f = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [b -> c
f b
x]
first :: forall b c d. IOLA b c -> IOLA (b, d) (c, d)
first (IOLA b -> IO [c]
f) = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ ~(b
x1, d
x2) -> do
[c]
ys1 <- b -> IO [c]
f b
x1
forall (m :: * -> *) a. Monad m => a -> m a
return [ (c
y1, d
x2) | c
y1 <- [c]
ys1 ]
second :: forall b c d. IOLA b c -> IOLA (d, b) (d, c)
second (IOLA b -> IO [c]
g) = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ ~(d
x1, b
x2) -> do
[c]
ys2 <- b -> IO [c]
g b
x2
forall (m :: * -> *) a. Monad m => a -> m a
return [ (d
x1, c
y2) | c
y2 <- [c]
ys2 ]
IOLA b -> IO [c]
f *** :: forall b c b' c'. IOLA b c -> IOLA b' c' -> IOLA (b, b') (c, c')
*** IOLA b' -> IO [c']
g = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ ~(b
x1, b'
x2) -> do
[c]
ys1 <- b -> IO [c]
f b
x1
[c']
ys2 <- b' -> IO [c']
g b'
x2
forall (m :: * -> *) a. Monad m => a -> m a
return [ (c
y1, c'
y2) | c
y1 <- [c]
ys1, c'
y2 <- [c']
ys2 ]
IOLA b -> IO [c]
f &&& :: forall b c c'. IOLA b c -> IOLA b c' -> IOLA b (c, c')
&&& IOLA b -> IO [c']
g = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> do
[c]
ys1 <- b -> IO [c]
f b
x
[c']
ys2 <- b -> IO [c']
g b
x
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 :: forall b c. IOLA b c
zeroArrow = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [])
instance ArrowPlus IOLA where
IOLA b -> IO [c]
f <+> :: forall b c. IOLA b c -> IOLA b c -> IOLA b c
<+> IOLA b -> IO [c]
g = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> do
[c]
rs1 <- b -> IO [c]
f b
x
[c]
rs2 <- b -> IO [c]
g b
x
forall (m :: * -> *) a. Monad m => a -> m a
return ([c]
rs1 forall a. [a] -> [a] -> [a]
++ [c]
rs2)
instance ArrowChoice IOLA where
left :: forall b c d. IOLA b c -> IOLA (Either b d) (Either c d)
left (IOLA b -> IO [c]
f) = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\ b
x -> b -> IO [c]
f b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ [c]
y -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [c]
y)))
(forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. a -> [a] -> [a]
:[]) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right)
right :: forall b c d. IOLA b c -> IOLA (Either d b) (Either d c)
right (IOLA b -> IO [c]
f) = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. a -> [a] -> [a]
:[]) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left)
(\ b
x -> b -> IO [c]
f b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ [c]
y -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [c]
y)))
instance ArrowApply IOLA where
app :: forall b c. IOLA (IOLA b c, b) c
app = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ (IOLA b -> IO [c]
f, b
x) -> b -> IO [c]
f b
x
instance ArrowList IOLA where
arrL :: forall b c. (b -> [c]) -> IOLA b c
arrL b -> [c]
f = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (b -> [c]
f b
x)
arr2A :: forall b c d. (b -> IOLA c d) -> IOLA (b, c) d
arr2A b -> IOLA c d
f = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ ~(b
x, c
y) -> forall a b. IOLA a b -> a -> IO [b]
runIOLA (b -> IOLA c d
f b
x) c
y
constA :: forall c b. c -> IOLA b c
constA c
c = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return [c
c])
isA :: forall b. (b -> Bool) -> IOLA b b
isA b -> Bool
p = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (if b -> Bool
p b
x then [b
x] else [])
IOLA b -> IO [c]
f >>. :: forall b c d. IOLA b c -> ([c] -> [d]) -> IOLA b d
>>. [c] -> [d]
g = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> do
[c]
ys <- b -> IO [c]
f b
x
forall (m :: * -> *) a. Monad m => a -> m a
return ([c] -> [d]
g [c]
ys)
instance ArrowIf IOLA where
ifA :: forall b c d. IOLA b c -> IOLA b d -> IOLA b d -> IOLA b d
ifA (IOLA b -> IO [c]
p) IOLA b d
ta IOLA b d
ea = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> do
[c]
res <- b -> IO [c]
p b
x
forall a b. IOLA a b -> a -> IO [b]
runIOLA (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
res then IOLA b d
ea else IOLA b d
ta) b
x
(IOLA b -> IO [c]
f) orElse :: forall b c. IOLA b c -> IOLA b c -> IOLA b c
`orElse` IOLA b c
g
= forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> do
[c]
res <- b -> IO [c]
f b
x
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
res then forall a b. IOLA a b -> a -> IO [b]
runIOLA IOLA b c
g b
x else forall (m :: * -> *) a. Monad m => a -> m a
return [c]
res
instance ArrowIO IOLA where
arrIO :: forall b c. (b -> IO c) -> IOLA b c
arrIO b -> IO c
cmd = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> do
c
res <- b -> IO c
cmd b
x
forall (m :: * -> *) a. Monad m => a -> m a
return [c
res]
instance ArrowExc IOLA where
tryA :: forall b c. IOLA b c -> IOLA b (Either SomeException c)
tryA IOLA b c
f = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> do
Either SomeException [c]
res <- forall a. IO a -> IO (Either SomeException a)
try' forall a b. (a -> b) -> a -> b
$ forall a b. IOLA a b -> a -> IO [b]
runIOLA IOLA b c
f b
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Either SomeException [c]
res of
Left SomeException
er -> [forall a b. a -> Either a b
Left SomeException
er]
Right [c]
ys -> [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' = forall e a. Exception e => IO a -> IO (Either e a)
try
instance ArrowIOIf IOLA where
isIOA :: forall b. (b -> IO Bool) -> IOLA b b
isIOA b -> IO Bool
p = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \b
x -> do
Bool
res <- b -> IO Bool
p b
x
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 :: forall c b. NFData c => IOLA b c -> IOLA b c
rnfA (IOLA b -> IO [c]
f) = forall a b. (a -> IO [b]) -> IOLA a b
IOLA forall a b. (a -> b) -> a -> b
$ \ b
x -> do
[c]
res <- b -> IO [c]
f b
x
[c]
res forall a b. NFData a => a -> b -> b
`deepseq` forall (m :: * -> *) a. Monad m => a -> m a
return [c]
res
instance ArrowWNF IOLA