{-# LANGUAGE RankNTypes #-}
module Control.Monad.Isolated(
Isolated(..),
Unite(..),
hoistUnite,
) where
import Data.Functor.Bind
import Data.Semigroup.Traversable
import Data.Semigroup.Foldable
import Data.Bifunctor (Bifunctor(..))
import Data.Proxy
import Control.Applicative (WrappedMonad(..))
newtype Unite f a = Unite { forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite :: Either a (f a) }
deriving (Int -> Unite f a -> ShowS
[Unite f a] -> ShowS
Unite f a -> String
(Int -> Unite f a -> ShowS)
-> (Unite f a -> String)
-> ([Unite f a] -> ShowS)
-> Show (Unite f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> Unite f a -> ShowS
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
[Unite f a] -> ShowS
forall (f :: * -> *) a. (Show a, Show (f a)) => Unite f a -> String
$cshowsPrec :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> Unite f a -> ShowS
showsPrec :: Int -> Unite f a -> ShowS
$cshow :: forall (f :: * -> *) a. (Show a, Show (f a)) => Unite f a -> String
show :: Unite f a -> String
$cshowList :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
[Unite f a] -> ShowS
showList :: [Unite f a] -> ShowS
Show, ReadPrec [Unite f a]
ReadPrec (Unite f a)
Int -> ReadS (Unite f a)
ReadS [Unite f a]
(Int -> ReadS (Unite f a))
-> ReadS [Unite f a]
-> ReadPrec (Unite f a)
-> ReadPrec [Unite f a]
-> Read (Unite f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec [Unite f a]
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec (Unite f a)
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (Unite f a)
forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [Unite f a]
$creadsPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (Unite f a)
readsPrec :: Int -> ReadS (Unite f a)
$creadList :: forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [Unite f a]
readList :: ReadS [Unite f a]
$creadPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec (Unite f a)
readPrec :: ReadPrec (Unite f a)
$creadListPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec [Unite f a]
readListPrec :: ReadPrec [Unite f a]
Read, Unite f a -> Unite f a -> Bool
(Unite f a -> Unite f a -> Bool)
-> (Unite f a -> Unite f a -> Bool) -> Eq (Unite f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
Unite f a -> Unite f a -> Bool
$c== :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
Unite f a -> Unite f a -> Bool
== :: Unite f a -> Unite f a -> Bool
$c/= :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
Unite f a -> Unite f a -> Bool
/= :: Unite f a -> Unite f a -> Bool
Eq, Eq (Unite f a)
Eq (Unite f a) =>
(Unite f a -> Unite f a -> Ordering)
-> (Unite f a -> Unite f a -> Bool)
-> (Unite f a -> Unite f a -> Bool)
-> (Unite f a -> Unite f a -> Bool)
-> (Unite f a -> Unite f a -> Bool)
-> (Unite f a -> Unite f a -> Unite f a)
-> (Unite f a -> Unite f a -> Unite f a)
-> Ord (Unite f a)
Unite f a -> Unite f a -> Bool
Unite f a -> Unite f a -> Ordering
Unite f a -> Unite f a -> Unite f a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (Unite f a)
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Bool
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Ordering
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Unite f a
$ccompare :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Ordering
compare :: Unite f a -> Unite f a -> Ordering
$c< :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Bool
< :: Unite f a -> Unite f a -> Bool
$c<= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Bool
<= :: Unite f a -> Unite f a -> Bool
$c> :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Bool
> :: Unite f a -> Unite f a -> Bool
$c>= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Bool
>= :: Unite f a -> Unite f a -> Bool
$cmax :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Unite f a
max :: Unite f a -> Unite f a -> Unite f a
$cmin :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
Unite f a -> Unite f a -> Unite f a
min :: Unite f a -> Unite f a -> Unite f a
Ord)
hoistUnite :: (forall a. f a -> g a) -> Unite f b -> Unite g b
hoistUnite :: forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Unite f b -> Unite g b
hoistUnite forall a. f a -> g a
fg = Either b (g b) -> Unite g b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Either b (g b) -> Unite g b)
-> (Unite f b -> Either b (g b)) -> Unite f b -> Unite g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f b -> g b) -> Either b (f b) -> Either b (g b)
forall a b. (a -> b) -> Either b a -> Either b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> g b
forall a. f a -> g a
fg (Either b (f b) -> Either b (g b))
-> (Unite f b -> Either b (f b)) -> Unite f b -> Either b (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite f b -> Either b (f b)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
instance (Functor g) => Functor (Unite g) where
fmap :: forall a b. (a -> b) -> Unite g a -> Unite g b
fmap a -> b
f = Either b (g b) -> Unite g b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Either b (g b) -> Unite g b)
-> (Unite g a -> Either b (g b)) -> Unite g a -> Unite g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (g a -> g b) -> Either a (g a) -> Either b (g b)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Either a (g a) -> Either b (g b))
-> (Unite g a -> Either a (g a)) -> Unite g a -> Either b (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite g a -> Either a (g a)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
instance (Foldable g) => Foldable (Unite g) where
foldMap :: forall m a. Monoid m => (a -> m) -> Unite g a -> m
foldMap a -> m
f = (a -> m) -> (g a -> m) -> Either a (g a) -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m
f ((a -> m) -> g a -> m
forall m a. Monoid m => (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) (Either a (g a) -> m)
-> (Unite g a -> Either a (g a)) -> Unite g a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite g a -> Either a (g a)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
instance (Foldable1 g) => Foldable1 (Unite g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Unite g a -> m
foldMap1 a -> m
f = (a -> m) -> (g a -> m) -> Either a (g a) -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m
f ((a -> m) -> g a -> m
forall m a. Semigroup m => (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) (Either a (g a) -> m)
-> (Unite g a -> Either a (g a)) -> Unite g a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite g a -> Either a (g a)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
instance (Traversable g) => Traversable (Unite g) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Unite g a -> f (Unite g b)
traverse a -> f b
f = (Either b (g b) -> Unite g b)
-> f (Either b (g b)) -> f (Unite g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either b (g b) -> Unite g b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (f (Either b (g b)) -> f (Unite g b))
-> (Unite g a -> f (Either b (g b))) -> Unite g a -> f (Unite g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Either b (g b)))
-> (g a -> f (Either b (g b)))
-> Either a (g a)
-> f (Either b (g b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b (g b)) -> f b -> f (Either b (g b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b (g b)
forall a b. a -> Either a b
Left (f b -> f (Either b (g b)))
-> (a -> f b) -> a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) ((g b -> Either b (g b)) -> f (g b) -> f (Either b (g b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g b -> Either b (g b)
forall a b. b -> Either a b
Right (f (g b) -> f (Either b (g b)))
-> (g a -> f (g b)) -> g a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> g a -> f (g b)
traverse a -> f b
f) (Either a (g a) -> f (Either b (g b)))
-> (Unite g a -> Either a (g a)) -> Unite g a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite g a -> Either a (g a)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
instance (Traversable1 g) => Traversable1 (Unite g) where
traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Unite g a -> f (Unite g b)
traverse1 a -> f b
f = (Either b (g b) -> Unite g b)
-> f (Either b (g b)) -> f (Unite g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either b (g b) -> Unite g b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (f (Either b (g b)) -> f (Unite g b))
-> (Unite g a -> f (Either b (g b))) -> Unite g a -> f (Unite g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Either b (g b)))
-> (g a -> f (Either b (g b)))
-> Either a (g a)
-> f (Either b (g b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b (g b)) -> f b -> f (Either b (g b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b (g b)
forall a b. a -> Either a b
Left (f b -> f (Either b (g b)))
-> (a -> f b) -> a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) ((g b -> Either b (g b)) -> f (g b) -> f (Either b (g b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g b -> Either b (g b)
forall a b. b -> Either a b
Right (f (g b) -> f (Either b (g b)))
-> (g a -> f (g b)) -> g a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b. Apply f => (a -> f b) -> g a -> f (g b)
traverse1 a -> f b
f) (Either a (g a) -> f (Either b (g b)))
-> (Unite g a -> Either a (g a)) -> Unite g a -> f (Either b (g b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unite g a -> Either a (g a)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite
class Functor m0 => Isolated m0 where
impureBind :: m0 a -> (a -> Unite m0 b) -> Unite m0 b
infixl 1 `impureBind`
instance Isolated m0 => Apply (Unite m0) where
<.> :: forall a b. Unite m0 (a -> b) -> Unite m0 a -> Unite m0 b
(<.>) = Unite m0 (a -> b) -> Unite m0 a -> Unite m0 b
forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault
instance Isolated m0 => Applicative (Unite m0) where
pure :: forall a. a -> Unite m0 a
pure = Either a (m0 a) -> Unite m0 a
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Either a (m0 a) -> Unite m0 a)
-> (a -> Either a (m0 a)) -> a -> Unite m0 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (m0 a)
forall a b. a -> Either a b
Left
<*> :: forall a b. Unite m0 (a -> b) -> Unite m0 a -> Unite m0 b
(<*>) = Unite m0 (a -> b) -> Unite m0 a -> Unite m0 b
forall a b. Unite m0 (a -> b) -> Unite m0 a -> Unite m0 b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
instance Isolated m0 => Bind (Unite m0) where
Unite (Left a
a) >>- :: forall a b. Unite m0 a -> (a -> Unite m0 b) -> Unite m0 b
>>- a -> Unite m0 b
k = a -> Unite m0 b
k a
a
Unite (Right m0 a
ma) >>- a -> Unite m0 b
k = m0 a
ma m0 a -> (a -> Unite m0 b) -> Unite m0 b
forall a b. m0 a -> (a -> Unite m0 b) -> Unite m0 b
forall (m0 :: * -> *) a b.
Isolated m0 =>
m0 a -> (a -> Unite m0 b) -> Unite m0 b
`impureBind` a -> Unite m0 b
k
instance Isolated m0 => Monad (Unite m0) where
>>= :: forall a b. Unite m0 a -> (a -> Unite m0 b) -> Unite m0 b
(>>=) = Unite m0 a -> (a -> Unite m0 b) -> Unite m0 b
forall a b. Unite m0 a -> (a -> Unite m0 b) -> Unite m0 b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)
instance Isolated Proxy where
Proxy a
_ impureBind :: forall a b. Proxy a -> (a -> Unite Proxy b) -> Unite Proxy b
`impureBind` a -> Unite Proxy b
_ = Either b (Proxy b) -> Unite Proxy b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Proxy b -> Either b (Proxy b)
forall a b. b -> Either a b
Right Proxy b
forall {k} (t :: k). Proxy t
Proxy)
instance Semigroup s => Isolated ((,) s) where
(s
s, a
a) impureBind :: forall a b. (s, a) -> (a -> Unite ((,) s) b) -> Unite ((,) s) b
`impureBind` a -> Unite ((,) s) b
k = case Unite ((,) s) b -> Either b (s, b)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite (a -> Unite ((,) s) b
k a
a) of
Left b
b -> Either b (s, b) -> Unite ((,) s) b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite ((s, b) -> Either b (s, b)
forall a b. b -> Either a b
Right (s
s, b
b))
Right (s
s', b
b) -> Either b (s, b) -> Unite ((,) s) b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite ((s, b) -> Either b (s, b)
forall a b. b -> Either a b
Right (s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
s', b
b))
instance Monad m => Isolated (WrappedMonad m) where
WrapMonad m a
ma impureBind :: forall a b.
WrappedMonad m a
-> (a -> Unite (WrappedMonad m) b) -> Unite (WrappedMonad m) b
`impureBind` a -> Unite (WrappedMonad m) b
k = Either b (WrappedMonad m b) -> Unite (WrappedMonad m) b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Either b (WrappedMonad m b) -> Unite (WrappedMonad m) b)
-> (m b -> Either b (WrappedMonad m b))
-> m b
-> Unite (WrappedMonad m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedMonad m b -> Either b (WrappedMonad m b)
forall a b. b -> Either a b
Right (WrappedMonad m b -> Either b (WrappedMonad m b))
-> (m b -> WrappedMonad m b) -> m b -> Either b (WrappedMonad m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> Unite (WrappedMonad m) b)
-> m b -> Unite (WrappedMonad m) b
forall a b. (a -> b) -> a -> b
$ m a
ma m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a ->
case Unite (WrappedMonad m) b -> Either b (WrappedMonad m b)
forall (f :: * -> *) a. Unite f a -> Either a (f a)
runUnite (a -> Unite (WrappedMonad m) b
k a
a) of
Left b
b -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
Right (WrapMonad m b
mb) -> m b
mb