Skip to content

Instantly share code, notes, and snippets.

@sellout sellout/par-seq.hs
Created Feb 2, 2018

Embed
What would you like to do?
-- === The Abstract ===
-- | A wrapper for `Applicative`-only semantics for types that also have a
-- `Monad`.
newtype Par m a = Par { unPar :: m a }
-- | A wrapper for `Monad` semantics for types that have a distinct
-- `Applicative`.
newtype Seq m a = Seq { unSeq :: m a }
instance Functor f => Functor (Par f) where
fmap f a = Par . fmap f $ unPar a
instance Functor f => Functor (Seq f) where
fmap f a = Seq . fmap f $ unSeq a
-- TODO: If I understood `ala` better, I might avoid these custom functions.
-- | The `Monad`-incompatible `<*>` operation.
(<\>) :: Applicative (Par f) => f (a -> b) -> f a -> f b
f <\> a = unPar $ Par f <*> Par a
-- | The `Monad`-compatible `<*>` operation.
(</>) :: Applicative (Seq f) => f (a -> b) -> f a -> f b
f </> a = unSeq $ Seq f <*> Seq a
-- | `>>=` applied to something with distinct `Applicative` semantics.
(>/=) :: Monad (Seq f) => f a -> (a -> f b) -> f b
ma >/= f = unSeq $ Seq ma >>= Seq . f
-- === The Concrete ===
-- Like `Either`, but without `Applicative` and `Monad` instances.
data Disj a b = Fst a | Snd b
instance Functor (Disj a) where
fmap _ (Fst a) = Fst a
fmap f (Snd b) = Snd $ f b
instance Semigroup a => Applicative (Par (Disj a)) where
pure = Par . Snd
Par f <*> Par a =
Par
$ case (f, a) of
(Fst f', Fst a') -> Fst $ f' <> a'
(Fst f', Snd _) -> Fst f'
(Snd _, Fst a') -> Fst a'
(Snd f', Snd a') -> Snd $ f' a'
instance Applicative (Seq (Disj a)) where
pure = Seq . Snd
Seq f <*> Seq a =
Seq
$ case (f, a) of
(Fst f', _) -> Fst f'
(Snd _, Fst a') -> Fst a'
(Snd f', Snd a') -> Snd $ f' a'
instance Monad (Seq (Disj a)) where
Seq (Fst a) >>= _ = Seq $ Fst a
Seq (Snd b) >>= f = f b
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.