Haskell reader excercise

haskell-reader-exercise.hs

{-# LANGUAGE InstanceSigs #-}

module LearnReader where

import Control.Applicative
import Data.Char

{-- 
    Chapter 22 Haskell Programming From First Principle
    Exercise page 809
--}

hurr = (*2)
durr = (+10)

-- composition = fmap
-- hurr ( durr x)
m :: Integer -> Integer
m = hurr . durr

m' :: Integer -> Integer
m' = fmap hurr durr


-- (hurr x) + (durr x)
-- distribution
m2 :: Integer -> Integer
m2 = (+) <$> hurr <*> durr

m3 :: Integer -> Integer
m3 = liftA2 (+) hurr durr

cap :: [Char] -> [Char]
cap xs = map toUpper xs

rev :: [Char] -> [Char]
rev xs = reverse xs

composed :: [Char] -> [Char]
composed = cap . rev

fmapped :: [Char] -> [Char]
fmapped = fmap cap rev

tupled :: [Char] -> ([Char], [Char])
tupled = do
    c <- cap 
    r <- rev
    return (c, r)

tupled' :: [Char] -> ([Char], [Char])
tupled' =
    cap >>= \c ->
    rev >>= \r ->
    return (r, c)

newtype Reader' r a = Reader' {
    runReader' :: r -> a
}

instance Functor (Reader' r) where
    fmap :: (a -> b) -> Reader' r a -> Reader' r b
    fmap f (Reader' ra) = Reader' $ f . ra

ask' :: Reader' a a
ask' = Reader' $ id


newtype HumanName =
    HumanName String
    deriving (Eq, Show)

newtype CatName =
    CatName String
    deriving (Eq, Show)

newtype Address =
    Address String
    deriving (Eq, Show)

data Person =
    Person {
      humanName :: HumanName
    , catName :: CatName
    , address :: Address
    } deriving (Eq, Show)

data Cat =
    Cat {
      catsName :: CatName
    , catsAddress :: Address
    } deriving (Eq, Show)

p :: Person
p =
    Person (HumanName "Sitosa")
        (CatName "Plutus")
        (Address "Kỳ Anh, Hà Tĩnh")
        

getCat :: Person -> Cat
getCat p =
    Cat (catName p) (address p)
    
getCatR :: Person -> Cat
-- Cat     :: CatName -> Address -> Cat  :: CatName -> (Address -> Cat) (1)
-- catName :: Person -> CatName          :: ((->) Person) CatName       (2)
-- address :: Person -> Address          :: ((->) Person) Address       (3)
-- (1) -> (2) -> (3) :: (a -> b -> c) -> f a -> f b
--      with
--          f :: ((->)) Person
--          a :: CatName
--          b :: Address
--          c :: Cat
-- (4) = (1) -> (2) -> (3) ::
--           (a -> b -> c)
--           -> f a
--           -> f b
-- let k = a -> b -> c = a -> (b -> c)
-- k ->  f a = a -> (b -> c) -> f a = k <$> f a :: f (b -> c) (4.1)
-- k -> f a  -> f b :: f (b->c) -> f b = f (b -> c) <*> f b :: f c
-- (4) :: k <$> f a <*> f b ::  f c
-- (4) :: Cat <$> catName <*> Address :: f Cat :: ((->)) Person Cat :: Person  -> Cat
getCatR p = (Cat <$> catName <*> address) p

getCatR' :: Person -> Cat
getCatR' = liftA2 Cat catName address

myLiftA2 :: Applicative f =>
       (a -> b -> c)
    -> f a -> f b -> f c
myLiftA2 g fa fb =
    let x = g <$> fa 
    in x <*> fb

asks :: (r -> a) -> Reader' r a
asks = Reader'

instance Applicative (Reader' r) where
    pure :: a -> Reader' r a
    pure a = Reader' $ \r -> a

    (<*>) :: Reader' r (a -> b)
          -> Reader' r a
          -> Reader' r b
    (Reader' rab) <*> (Reader' ra) =
        Reader' $ \r -> rab r (ra r)


getCatR'' :: Reader' Person Cat
getCatR'' =
    let x = Cat <$> catName -- :: Person -> Address -> Cat :: ((->) Person) Address -> Cat
        y = address         -- :: Person -> Address        :: ((->) Person) Address
        z = x <*> address   -- :: Person -> Cat            :: ((->) Person) Cat             :: Person -> Cat
    in Reader' z