module Hasklet3 where

import Data.Semigroup (All(..))


-- | A list of pairs of elements of type a AND b.
data ListP a b
   = NilP
   | ConsP a b (ListP a b)
  deriving (Eq,Show)

-- | A list of elements of either type a OR b.
data ListE a b
   = NilE
   | ConsL a (ListE a b)
   | ConsR b (ListE a b)
  deriving (Eq,Show)

-- | Containers with two different element types that can be mapped over.
--
--   Instances of Bifunctor should satisfy the following laws:
--    * bimap id id  <=>  id
--    * bimap (f1 . f2) (g1 . g2)  <=>  bimap f1 g1 . bimap f2 g2
--
class Bifunctor t where
  bimap :: (a -> c) -> (b -> d) -> t a b -> t c d

-- | Test cases for Bifunctor instances.
--   
--   >>> bimap (+1) (>3) (ConsP 1 2 (ConsP 3 4 NilP))
--   ConsP 2 False (ConsP 4 True NilP)
--   
--   >>> bimap (+1) even (ConsL 1 (ConsR 2 (ConsR 3 (ConsL 4 NilE))))
--   ConsL 2 (ConsR True (ConsR False (ConsL 5 NilE)))
--

-- [Bifunctor instances go here.]

instance Bifunctor ListP where
  bimap f g NilP = NilP
  bimap f g (ConsP a b r) = ConsP (f a) (g b) $ bimap f g r

instance Bifunctor ListE where
  bimap f g NilE = NilE
  bimap f g (ConsL a r) = ConsL (f a) $ bimap f g r
  bimap f g (ConsR b r) = ConsR (g b) $ bimap f g r

-- | Map over the left elements of a bifunctor.
--
--   >>> mapL (+5) (ConsP 1 2 (ConsP 3 4 NilP))
--   ConsP 6 2 (ConsP 8 4 NilP)
--
--   >>> mapL even (ConsL 1 (ConsR 2 (ConsR 3 (ConsL 4 NilE))))
--   ConsL False (ConsR 2 (ConsR 3 (ConsL True NilE)))
--
mapL :: Bifunctor t => (a -> c) -> t a b -> t c b
mapL = flip bimap id

-- | Map over the right elements of a bifunctor.
--
--   >>> mapR (+5) (ConsP 1 2 (ConsP 3 4 NilP))
--   ConsP 1 7 (ConsP 3 9 NilP)
--   
--   >>> mapR even (ConsL 1 (ConsR 2 (ConsR 3 (ConsL 4 NilE))))
--   ConsL 1 (ConsR True (ConsR False (ConsL 4 NilE)))
--
mapR :: Bifunctor t => (b -> c) -> t a b -> t a c
mapR = bimap id


-- | Containers with two different element types that can be folded to
--   a single summary value.
class Bifoldable t where
  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c


-- | Test cases for Bifoldable instances.
--   
--   >>> let addL x (y,z) = (x+y, z)
--   >>> let mulR x (y,z) = (y, x*z)
--   
--   >>> bifoldr addL mulR (0,1) (ConsP 1 2 (ConsP 3 4 NilP))
--   (4,8)
--   
--   >>> bifoldr addL mulR (0,1) (ConsL 1 (ConsR 2 (ConsR 3 (ConsL 4 NilE))))
--   (5,6)
--

-- [Bifoldable instances go here.]

instance Bifoldable ListP where
  bifoldr _ _ c NilP = c
  bifoldr f g c (ConsP a b r) = f a $ g b $ bifoldr f g c r

instance Bifoldable ListE where
  bifoldr _ _ c NilE = c
  bifoldr f g c (ConsL a r) = f a $ bifoldr f g c r
  bifoldr f g c (ConsR b r) = g b $ bifoldr f g c r

-- | Fold over the left elements of a bifoldable.
--
--   >>> foldrL (+) 0 (ConsP 2 3 (ConsP 4 5 NilP))
--   6
--
--   >>> foldrL (*) 1 (ConsL 2 (ConsR 3 (ConsR 4 (ConsL 5 NilE))))
--   10
--
foldrL :: Bifoldable t => (a -> c -> c) -> c -> t a b -> c
foldrL = flip bifoldr (const id)

-- | Fold over the right elements of a bifoldable.
--
--   >>> foldrR (+) 0 (ConsP 2 3 (ConsP 4 5 NilP))
--   8
--
--   >>> foldrR (*) 1 (ConsL 2 (ConsR 3 (ConsR 4 (ConsL 5 NilE))))
--   12
--
foldrR :: Bifoldable t => (b -> c -> c) -> c -> t a b -> c
foldrR = bifoldr (const id)

-- | Map each element in a bifoldable to a common monoid type and combine
--   the results. This function is used by the 'checkAll' and 'toEitherList'
--   functions below.
--
--   >>> checkAll odd even (ConsP 1 2 (ConsP 3 4 NilP))
--   True
--
--   >>> checkAll odd even (ConsL 1 (ConsL 2 (ConsL 3 (ConsR 4 NilE))))
--   False
--
--   >>> toEitherList (ConsP 1 True (ConsP 2 False NilP))
--   [Left 1,Right True,Left 2,Right False]
--
--   >>> toEitherList (ConsL 1 (ConsL 2 (ConsL 3 (ConsR "hi" NilE))))
--   [Left 1,Left 2,Left 3,Right "hi"]
--
bifoldMap :: (Monoid m, Bifoldable t) => (a -> m) -> (b -> m) -> t a b -> m
bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty

-- Jack tried doing it point free, so I did too!
-- bifoldMap = (.(mappend.)).flip flip mempty.bifoldr.(mappend.)

-- | Check whether all of the elements in a bifoldable satisfy the given
--   predicates. The 'All' monoid used in the implementation is the boolean
--   monoid under conjunction.
checkAll :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool
checkAll f g = getAll . bifoldMap (All . f) (All . g)

-- | Create a list of all elements in a bifoldable.
toEitherList :: Bifoldable t => t a b -> [Either a b]
toEitherList = bifoldMap (\x -> [Left x]) (\y -> [Right y])