Practicing Bifunctor instances

Haskell Excercises & Code/Chapter25 - Composing Types/92b7cb37-2583-4e69-b659-1a761af1d688.hs

@@ -0,0 +1,22 @@
+module Bifa where
+
+class Bifunctor p where
+    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
+    bimap f g = first f . second g
+
+    first :: (a -> b) -> p a c -> p b c
+    first f = bimap f id
+
+    second :: (b -> c) -> p a b -> p a c
+    second = bimap id
+
+class Functor f where
+    fmap :: (a->b) -> f a -> f b
+
+-- Write BiFunctor instances
+-- 1.
+data Deux a b = Deux a b
+
+instance Bifunctor Deux where
+    bimap f g (Deux a b) = Deux $ (f a) . (g b)
+

Haskell Excercises & Code/Chapter25 - Composing Types/compos101.hs

@@ -1,8 +1,12 @@
+{-# LANGUAGE InstanceSigs #-}
+
 module Composa where
 
--- newtype Compose f g a =
---     Compose { getCompose :: f (g a) }
---     deriving (Eq, Show)
+import Control.Applicative
+
+newtype Compose f g a =
+    Compose { getCompose :: f (g a) }
+    deriving (Eq, Show)
 
 newtype One f a = One (f a) deriving (Eq, Show)
 
@@ -14,4 +18,24 @@ newtype Three f g h a =
         deriving (Eq, Show)
 
 instance (Functor f, Functor g, Functor h) => Functor (Three f g h) where
-    fmap f (Three fgha) = Three $ (fmap . fmap . fmap) f fgha
+    fmap f (Three fgha) = Three $ (fmap . fmap . fmap) f fgha
+
+-- instance types provided as
+-- they may help.
+
+instance (Functor f, Functor g) => Functor (Compose f g) where
+    fmap f (Compose fga) = Compose $ (fmap . fmap) f fga
+
+instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+    pure :: a -> Compose f g a
+    -- identity law
+    -- pure id <*> v = v
+    pure = Compose $ (pure . pure)
+    --(<*>) :: Compose f g (a -> b) -> Compose f g a -> Compose f g b
+    -- this is wrong
+    -- (Compose f) <*> (Compose a) = Compose $ (fmap <*> f) <*> a
+
+instance (Foldable f, Foldable g) => Foldable (Compose f g) where
+    foldMap f (Compose fga) = (foldMap . foldMap) f fga
+    -- a -> m
+    --        t a (t = Compose f g)

Haskell Excercises & Code/Chapter25 - Composing Types/funExer.hs

@@ -0,0 +1,44 @@
+module Bifa where
+
+class Bifunctor p where
+    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
+    bimap f g = first f . second g
+
+    first :: (a -> b) -> p a c -> p b c
+    first f = bimap f id
+
+    second :: (b -> c) -> p a b -> p a c
+    second = bimap id
+
+class Functor f where
+    fmap :: (a->b) -> f a -> f b
+
+-- Write BiFunctor instances
+-- 1.
+data Deux a b = Deux a b
+
+instance Bifunctor Deux where
+    bimap f g (Deux a b) = Deux (f a)  (g b)
+    first f (Deux a b)   = Deux (f a) b 
+    second f (Deux a b)  = Deux a (f b)
+
+-- 2. 
+data Const a b = Const a
+
+instance Bifunctor Const where
+    bimap f g (Const a) = Const (f a)
+    first f (Const a)   = Const (f a)
+
+--3.s
+data Drei a b c = Drei a b c
+
+instance Bifunctor (Drei a) where
+    bimap f g (Drei a b c) = Drei a (f b) (g c)
+    first f (Drei a b c)   = Drei a (f b) c
+    second f (Drei a b c)  = Drei a b (f c)
+
+-- 4
+data SuperDrei a b c = SuperDrei a b
+
+instance Bifunctor (SuperDrei a) where
+    bimap f _ (SuperDrei a b) = SuperDrei a (f b)