-- 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