fpc-18-10-2017.hs

import Data.Monoid

newtype Endom a = Endom { appEndom :: a -> a }

instance Monoid (Endom a) where
  mempty = Endom id
  Endom f `mappend` Endom g = Endom (f . g)

  -- mempty `mappend` x = x
  -- Endom id `mappend` Endom x = Endom (id . x)
  -- Endom (\y => id (x y)) = Endom (\y => x y) = Endom x
  --
  -- id x = x
  --
  -- x `mappend` mempty = x
  -- (x `mappend` y) `mappend` z = x `mappend` (y `mappend` z)
  --
  -- (f . g) = \x => f (g x)

fn = mconcat (map Endom [(+5), (*3), (^2)])
-- = Endom (+5) `mappend` Endom (*3) `mappend`
--      Endom (^2) `mappend` mempty
-- = Endom ((+5) . (*3) . (^2) . id)
-- appEndom fn 2

fn' = mconcat (map (Dual . Endom) [(+5), (*3), (^2)])
-- = Dual (Endom ((^2) . (*3) . (+5) . id))
-- appEndom (getDual fn') 2

data Maybe' a = Nothing' | Just' a
  deriving Eq

testMonoid :: [Bool]
testMonoid =
  [ mempty `mappend` Just' [2] == (Just' [2] :: Maybe' [Int])
  , mempty `mappend` mempty == (mempty :: Maybe' [Int])
  , Just' [1] `mappend` mempty == (Just' [1] :: Maybe' [Int])
  , Just' [1] `mappend` (Just' [2] `mappend` Just' [3])
      == ((Just' [1] `mappend` Just' [2]) `mappend` Just' [3]
          :: Maybe' [Int])
  ]

{-
instance Monoid (Maybe' a) where
  mempty = Nothing'
  mappend Nothing' y = y
  mappend x _ = x
-}

-- instance Eq a => Ord a
-- instance Eq a => Eq [a]

{-
instance Monoid a => Monoid (Maybe' a) where
  mempty = Nothing'
  mappend (Just' a) (Just' b) = Just' (mappend a b)
  mappend x Nothing' = x
  mappend Nothing' y = y
-}

instance Monoid a => Monoid (Maybe' a) where
  mempty = Just' mempty
  mappend (Just' a) (Just' b) = Just' (mappend a b)
  mappend x Nothing' = x
  mappend Nothing' y = y

-- foldr f ini [1,2,3] = 1 `f` (2 `f` (3 `f` ini))

length' :: [a] -> Int
length' = foldr (const (+1)) 0
length' = foldl' (const . (+1)) 0
length' = foldl' (\xs x -> xs + 1) 0

maximum' :: Ord a => [a] -> a
maximum' = foldr1 max

head' :: [a] -> a
head' = foldr1 (\x xs -> x) = foldr1 const

last' :: [a] -> a
last' = foldr1 (\x xs -> xs) = foldr1 (const id)

filter' :: (a -> Bool) -> [a] -> [a]
filter' f = foldr (\x xs -> if f x then x : xs else xs) []

map' :: (a -> b) -> [a] -> [b]
map' f = foldr (\x xs -> f x : xs) []

take' :: Int -> [a] -> [a]
take' n xs = foldr step (const []) xs n
 where step x g 0 = []
       step x g n = x : g (n - 1)

take' 2 [1,2,3,4]
= (foldr step (const []) [1,2,3,4]) 2
= (1 `step` 2 `step` 3 `step` 4 `step` const []) 2
= (step 1 (step 2 (step 3 (step 4 (const []))))) 2
= 1 : (step 2 (step 3 (step 4 (const [])))) 1
= 1 : 2 : (step 3 (step 4 (const []))) 0
= 1 : 2 : []
= [1, 2]

= take' 2 [1]
= (foldr step (const []) [1]) 2
= (step 1 (const [])) 2
= 1 : (const []) 1
= 1 : []


-- foldr step (const [])
--
--