aboutsummaryrefslogtreecommitdiff
path: root/Haskell-book/26/MaybeT/src/Either.hs
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2025-12-11 10:28:11 +0100
committerEugen Wissner <belka@caraus.de>2025-12-11 10:28:11 +0100
commit98329e0a3dd4f78b5d815ac3896272ec70904901 (patch)
tree80f9c56cfe2ac20232358f236d32e84bd683be1b /Haskell-book/26/MaybeT/src/Either.hs
parent3624c712d72d246f21d4e710cec7c11e052e0326 (diff)
downloadbook-exercises-98329e0a3dd4f78b5d815ac3896272ec70904901.tar.gz
Add remaining haskell book exercises
Diffstat (limited to 'Haskell-book/26/MaybeT/src/Either.hs')
-rw-r--r--Haskell-book/26/MaybeT/src/Either.hs56
1 files changed, 56 insertions, 0 deletions
diff --git a/Haskell-book/26/MaybeT/src/Either.hs b/Haskell-book/26/MaybeT/src/Either.hs
new file mode 100644
index 0000000..e09bfe6
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/Either.hs
@@ -0,0 +1,56 @@
+module Either where
+
+import Control.Monad (liftM)
+import MonadTrans
+import MonadIO
+
+newtype EitherT e m a =
+ EitherT { runEitherT :: m (Either e a) }
+
+-- 1
+instance Functor m => Functor (EitherT e m) where
+ fmap f (EitherT x) = EitherT $ (fmap . fmap) f x
+
+-- 2
+instance Applicative m => Applicative (EitherT e m) where
+ pure x = EitherT $ pure $ pure x
+
+ (EitherT f) <*> (EitherT a) = EitherT $ (<*>) <$> f <*> a
+
+-- 3
+instance Monad m => Monad (EitherT e m) where
+ return = pure
+
+ (EitherT em) >>= f = EitherT $ do
+ v <- em
+ case v of
+ Left y -> return $ Left y
+ Right y -> runEitherT (f y)
+
+
+-- 4
+-- transformer version of swapEither.
+-- Hint: write swapEither first, then swapEitherT in terms of the former.
+swapEither :: Either e a -> Either a e
+swapEither (Left x) = Right x
+swapEither (Right y) = Left y
+
+swapEitherT :: (Functor m)
+ => EitherT e m a
+ -> EitherT a m e
+swapEitherT (EitherT x) = EitherT $ fmap swapEither x
+
+-- 5. Write the transformer variant of the either catamorphism.
+eitherT :: Monad m
+ => (a -> m c)
+ -> (b -> m c)
+ -> EitherT a m b
+ -> m c
+eitherT f g (EitherT x) = x >>= (either f g)
+
+instance MonadTrans (EitherT e) where
+ lift = EitherT . liftM Right
+
+instance (MonadIO m)
+ => MonadIO (EitherT e m) where
+ liftIO = lift . liftIO