From 98329e0a3dd4f78b5d815ac3896272ec70904901 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Thu, 11 Dec 2025 10:28:11 +0100
Subject: Add remaining haskell book exercises

---
 Haskell-book/18/Instance/src/Identity.hs        | 24 ++++++++++++++
 Haskell-book/18/Instance/src/List.hs            | 44 +++++++++++++++++++++++++
 Haskell-book/18/Instance/src/Nope.hs            | 23 +++++++++++++
 Haskell-book/18/Instance/src/PhhhbbtttEither.hs | 38 +++++++++++++++++++++
 Haskell-book/18/Instance/src/Sum.hs             | 31 +++++++++++++++++
 5 files changed, 160 insertions(+)
 create mode 100644 Haskell-book/18/Instance/src/Identity.hs
 create mode 100644 Haskell-book/18/Instance/src/List.hs
 create mode 100644 Haskell-book/18/Instance/src/Nope.hs
 create mode 100644 Haskell-book/18/Instance/src/PhhhbbtttEither.hs
 create mode 100644 Haskell-book/18/Instance/src/Sum.hs

(limited to 'Haskell-book/18/Instance/src')

diff --git a/Haskell-book/18/Instance/src/Identity.hs b/Haskell-book/18/Instance/src/Identity.hs
new file mode 100644
index 0000000..13cd1b2
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Identity.hs
@@ -0,0 +1,24 @@
+module Identity where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+newtype Identity a = Identity a
+    deriving (Eq, Ord, Show)
+
+instance Functor Identity where
+    fmap f (Identity x) = Identity $ f x
+
+instance Applicative Identity where
+    pure = Identity
+    (Identity f) <*> x = fmap f x
+
+instance Monad Identity where
+    return = pure
+    (Identity x) >>= f = f x
+
+instance Arbitrary a => Arbitrary (Identity a) where
+    arbitrary = fmap Identity $ arbitrary
+
+instance Eq a => EqProp (Identity a) where
+    (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/List.hs b/Haskell-book/18/Instance/src/List.hs
new file mode 100644
index 0000000..bd3a06b
--- /dev/null
+++ b/Haskell-book/18/Instance/src/List.hs
@@ -0,0 +1,44 @@
+module List where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data List a =
+    Nil
+  | Cons a (List a)
+  deriving (Eq, Show)
+
+instance Functor List where
+    fmap f Nil = Nil
+    fmap f (Cons x xs) = Cons (f x) (fmap f xs)
+
+append :: List a -> List a -> List a
+append Nil ys = ys
+append (Cons x xs) ys = Cons x $ xs `append` ys
+
+fold :: (a -> b -> b) -> b -> List a -> b
+fold _ b Nil = b
+fold f b (Cons h t) = f h (fold f b t)
+
+concat' :: List (List a) -> List a
+concat' = fold append Nil
+
+flatMap :: (a -> List b) -> List a -> List b
+flatMap f as = concat' $ fmap f as
+
+instance Applicative List where
+    pure f = Cons f Nil
+    Nil <*> _ = Nil
+    _ <*> Nil = Nil
+    f <*> x = flatMap (\f' -> fmap f' x) f
+
+instance Monad List where
+    return = pure
+    x >>= f = concat' $ fmap f x
+
+instance Arbitrary a => Arbitrary (List a) where
+    arbitrary = frequency [(1, pure Nil),
+                           (5, Cons <$> arbitrary <*> arbitrary)]
+
+instance Eq a => EqProp (List a) where
+    (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/Nope.hs b/Haskell-book/18/Instance/src/Nope.hs
new file mode 100644
index 0000000..9a7fea1
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Nope.hs
@@ -0,0 +1,23 @@
+module Nope where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data Nope a = NopeDotJpg deriving (Show, Eq)
+
+instance Functor Nope where
+    fmap _ _ = NopeDotJpg
+
+instance Applicative Nope where
+    pure _ = NopeDotJpg
+    _ <*> _ = NopeDotJpg
+
+instance Monad Nope where
+    return _ = NopeDotJpg
+    _ >>= _ = NopeDotJpg
+
+instance Arbitrary (Nope a) where
+    arbitrary = return NopeDotJpg
+
+instance EqProp (Nope a) where
+    (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/PhhhbbtttEither.hs b/Haskell-book/18/Instance/src/PhhhbbtttEither.hs
new file mode 100644
index 0000000..0fc6acc
--- /dev/null
+++ b/Haskell-book/18/Instance/src/PhhhbbtttEither.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module PhhhbbtttEither where
+
+import Prelude ( Monad(..)
+               , Functor(..)
+               , Applicative(..)
+               , Eq(..)
+               , ($)
+               , Show(..) )
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data PhhhbbtttEither b a =
+        Left a
+      | Right b
+      deriving (Eq, Show)
+
+instance Functor (PhhhbbtttEither b) where
+    fmap f (Right x) = Right x
+    fmap f (Left x) = Left $ f x
+
+instance Applicative (PhhhbbtttEither b) where
+    pure x = Left x
+    Right f <*> _ = Right f
+    Left f <*> x = fmap f x
+
+instance Monad (PhhhbbtttEither b) where
+    return = pure
+    (Right x) >>= f = Right x
+    (Left x) >>= f = f x
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (PhhhbbtttEither b a) where
+    arbitrary = frequency [ (1, fmap Right arbitrary)
+                          , (1, fmap Left arbitrary)
+                          ]
+
+instance (Eq a, Eq b) => EqProp (PhhhbbtttEither b a) where
+    (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/Sum.hs b/Haskell-book/18/Instance/src/Sum.hs
new file mode 100644
index 0000000..d51b211
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Sum.hs
@@ -0,0 +1,31 @@
+module Sum where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data Sum a b =
+    First a
+  | Second b
+  deriving (Eq, Show)
+
+instance Functor (Sum a) where
+    fmap f (First x) = First x
+    fmap f (Second x) = Second $ f x
+
+instance Applicative (Sum a) where
+    pure x = Second x
+    First f <*> _ = First f
+    Second f <*> x = fmap f x
+
+instance Monad (Sum a) where
+    return = pure
+    (First x) >>= f = First x
+    (Second x) >>= f = f x
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Sum a b) where
+    arbitrary = frequency [ (1, fmap First arbitrary)
+                          , (1, fmap Second arbitrary)
+                          ]
+
+instance (Eq a, Eq b) => EqProp (Sum a b) where
+    (=-=) = eq
-- 
cgit v1.2.3