hw8/Party.hs

   1 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
   2 module Party where
   3
   4 import Data.Monoid
   5 import Employee
   6 import Data.Tree
   7
   8 -- exercise 1
   9 -- glCons - a naive way to add an employee to a guest list
  10 glCons :: Employee -> GuestList -> GuestList
  11 glCons e@(Emp {empFun = funval}) (GL els fun) = GL (e:els) (fun + funval)
  12
  13 -- Monoid instance for GuestList
  14 instance Monoid GuestList where
  15   mempty = GL [] 0
  16   (GL el1 f1) `mappend` (GL el2 f2) = GL (el1 ++ el2) (f1 + f2)
  17
  18 -- moreFun
  19 moreFun :: GuestList -> GuestList -> GuestList
  20 moreFun g1 g2 | g1 > g2 = g1
  21               | otherwise = g2
  22
  23 -- treeFold :: (Tree a -> b -> b) -> b -> Tree a -> b
  24 -- treeFold combine e= treeDestructor e f
  25 --     where f _ ts = let vs = map (\t1 -> treeFold combine e t1) ts in
  26 --                    foldr (\acc v -> combine v acc) e vs
  27 --           treeDestructor _ f1 t1 = case t1 of
  28 --                          (Node v xs) -> f1 v xs
  29
  30
  31 -- treeFold :: (t1 -> [b] -> b) -> Tree t1 -> b
  32 -- treeFold combine = treeDestructor f
  33 --      where f v ts = let vs = map (\t -> treeFold combine t) ts in
  34 --                     combine v vs
  35 --            treeDestructor f1 t1 = case t1 of
  36 --                                     (Node v xs) -> f1 v xs
  37 treeFold :: (b -> a -> b) -> b -> Tree a -> b
  38 treeFold f e (Node v []) = f e v
  39 treeFold f e (Node v ts) = let b = foldr (\t acc -> treeFold f acc t) e ts
  40                            in
  41                              f b v
  42 -- exercise 3
  43 -- nextLevel
  44 -- if the big boss comes, no question, his reportee managers are not
  45 -- coming. So, we just take the send list from each pair and concat them.
  46 -- if the big boss is not coming, then we pick the list from the pair that
  47 -- has most fun and concat them all.
  48 nextLevel :: Employee -> [(GuestList, GuestList)] -> (GuestList, GuestList)
  49 nextLevel e lst =
  50     let withBoss = glCons e $ mconcat $ map snd lst
  51         withoutBoss = mconcat $ map (uncurry moreFun) lst
  52     in
  53       (withBoss, withoutBoss)