• Functors
• Seq

lec02.hs:

-- class Functor f :: Type -> Type where
--  fmap :: (a -> b) -> f a -> f b
--
-- Rules:
-- 1. fmap id == id
-- 2. fmap (f . g) = fmap f . fmap g
--
-- "Things that contain values and then you can map over those values"

-- Simplest time we can write a functor for
data Box a = Box a
  deriving (Show, Eq)

instance Functor Box where
  -- We have:
  -- f :: a -> b
  -- x :: a
  -- Want:
  -- Box b
  -- fmap :: (a -> b) -> Box a -> Box b
  fmap f (Box a) =
    let y = f a
     in Box y

-- Equivalently:
-- fmap f (Box a) = Box (f a)
-- fmap f (Box a) = Box $ f a
--
-- Let's prove the functor rules:
-- (1.)
-- fmap id (Box x)
-- = Box (id x)
-- = Box x
-- = id (Box x)

-- Some things don't really work as containers, but can still implement Functor

data Fun a b = Fun (a -> b)

instance Functor (Fun a) where
  -- fmap :: (a -> b) -> Fun c a -> Fun c b
  -- f :: a -> b
  -- b :: c -> a
  -- Want: c -> b
  fmap f (Fun g) = Fun (f . g)

-- Alternatively:
-- fmap f (Fun g) = Fun (\a -> g(f a))

-- `Maybe`
-- Can be used to model computations that can fail.
data SomeTimes a = Nope | Yup a

instance Functor SomeTimes where
  fmap _ Nope = Nope
  fmap f (Yup a) = Yup $ f a

-- Note: fmap = (<$>)

instance Applicative SomeTimes where
  -- (<*>) :: SomeTimes (a -> b) -> SomeTimes a -> SomeTimes b
  (<*>) _ Nope = Nope
  (<*>) Nope _ = Nope
  (<*>) (Yup f) (Yup a) = Yup $ f a

  -- pure :: a -> SomeTimes a
  pure a = Yup a

-- Alternatively (partial application)
-- pure = Yup

instance Monad SomeTimes where
  -- (>>=) :: SomeTimes a -> (a -> SomeTimes b) -> SomeTimes b
  (>>=) Nope _ = Nope
  (>>=) (Yup a) f = case f a of
    Nope -> Nope
    Yup b -> Yup b

-- (>>=) (Yup a) f = f a

someTimesHead :: [a] -> SomeTimes a
someTimesHead [] = Nope
someTimesHead (x : _) = Yup x

lec02_seq.hs:

-- We can decide not to handle a datatype's implementation completely internally.
-- We can do that by not exporting any of its constructors.
module Seq (Seq (..)) where

import Control.Monad (ap, liftM)
import Data.Semigroup (Semigroup)

data Seq a
  = Empty
  | Single a
  | Concat (Seq a) (Seq a)
  deriving (Show)

uncons :: Seq a -> Maybe (a, Seq a)
uncons = undefined

instance (Eq a) => Eq (Seq a) where
  s1 == s2 = case (uncons s1, uncons s2) of
    (Nothing, Nothing) -> True
    (Just (x, xs), Just (y, ys)) -> x == y && xs == ys
    _ -> False

isEmpty :: Seq a -> Bool
isEmpty Empty = True
isEmpty (Single _) = False
isEmpty (Concat a b) = isEmpty a || isEmpty b

singleton :: a -> Seq a
singleton = Single

instance Monad Seq where
  (>>=) Empty _ = Empty
  (>>=) (Single a) f = f a
  (>>=) (Concat a b) f = case (a >>= f, b >>= f) of
    (Empty, b) -> b
    -- (a, Empty) -> a
    (a, b) -> Concat a b

instance Applicative Seq where
  pure = Single
  (<*>) = ap

-- instance Functor Seq where
--   fmap = liftM

instance Functor Seq where
  fmap f Empty = Empty
  fmap f (Single x) = Single (f x)
  fmap f (Concat x y) = Concat (fmap f x) (fmap f y)

-- Monoid:
-- type t
-- x :: t
-- op :: t -> t -> t
-- n :: t
--
-- Where:
-- op x n == x == op n x (n is an identity element)
-- (x `op` y) `op` z == x `op` ( y `op` z ) (op is associative)
--
-- For example:
-- type = int
-- op = (+)
-- n = 0

-- Monoid is split into Semigroup and Monoid

-- class Semigroup a where
--   -- op
--   (<>) :: a -> a -> a
--
-- class Semigroup a => Monoid a where
--   -- n
--   mempty :: a
--
-- x <> mempty == mempty <> x = x

data MyList a = MyNil | MyCons a (MyList a)

instance Semigroup (MyList a) where
  MyNil <> b = b
  -- a <> MyNil = a
  (MyCons x xs) <> l2 = MyCons x (xs <> l2)

instance Monoid (MyList a) where
  mempty = MyNil

instance Semigroup (Seq a) where
  Empty <> s2 = s2
  s1 <> Empty = s1
  s1 <> s2 = Concat s1 s2

instance Monoid (Seq a) where
  mempty = Empty

instance Foldable Seq where
  -- foldMap :: Monoid m => (a -> m) -> Seq a -> m
  foldMap f Empty = mempty
  foldMap f (Single x) = f x
  foldMap f (Concat s1 s2) = foldMap f s1 <> foldMap f s2

newtype Sum a = Sum a

instance (Num a) => Semigroup (Sum a) where
  (Sum a) <> (Sum b) = Sum $ a + b

instance (Num a) => Monoid (Sum a) where
  mempty = Sum 0

myLength :: (Foldable t) => t a -> Int
myLength l = let Sum acc = foldMap (\_ -> Sum 1) l in acc

-- sum :: (Monoid a, Foldable t) => t a -> a
-- sum = foldMap id

mySum :: (Num a, Foldable t) => t a -> a
mySum l = let Sum acc = foldMap Sum l in acc

data Vec3 a = Vec3 a a a deriving (Functor)

instance Foldable Vec3 where
  foldMap f (Vec3 x y z) = f x <> f y <> f z

normalize :: (Foldable t, Functor t, Floating a, Fractional a) => t a -> t a
normalize v = let s = sqrt (sum (fmap (** 2) v)) in fmap (/ s) v