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 import qualified Data.List as L
   8
   9 -- exercise 1
  10 -- glCons - a naive way to add an employee to a guest list
  11 glCons :: Employee -> GuestList -> GuestList
  12 glCons e@(Emp {empFun = funval}) (GL els fun) = GL (e:els) (fun + funval)
  13
  14 -- Monoid instance for GuestList
  15 instance Monoid GuestList where
  16   mempty = GL [] 0
  17   (GL el1 f1) `mappend` (GL el2 f2) = GL (el1 ++ el2) (f1 + f2)
  18
  19 -- moreFun
  20 moreFun :: GuestList -> GuestList -> GuestList
  21 moreFun g1 g2 | g1 > g2 = g1
  22               | otherwise = g2
  23
  24 -- treeFold :: (Tree a -> b -> b) -> b -> Tree a -> b
  25 -- treeFold combine e= treeDestructor e f
  26 --     where f _ ts = let vs = map (\t1 -> treeFold combine e t1) ts in
  27 --                    foldr (\acc v -> combine v acc) e vs
  28 --           treeDestructor _ f1 t1 = case t1 of
  29 --                          (Node v xs) -> f1 v xs
  30
  31
  32 -- treeFold :: (t1 -> [b] -> b) -> Tree t1 -> b
  33 -- treeFold combine = treeDestructor f
  34 --      where f v ts = let vs = map (\t -> treeFold combine t) ts in
  35 --                     combine v vs
  36 --            treeDestructor f1 t1 = case t1 of
  37 --                                     (Node v xs) -> f1 v xs
  38 treeFold :: (b -> a -> b) -> b -> Tree a -> b
  39 treeFold f e (Node v []) = f e v
  40 treeFold f e (Node v ts) = let b = foldr (\t acc -> treeFold f acc t) e ts
  41                            in
  42                              f b v
  43 -- exercise 3
  44 -- nextLevel
  45 -- if the big boss comes, no question, his reportee managers are not
  46 -- coming. So, we just take the send list from each pair and concat them.
  47 -- if the big boss is not coming, then we pick the list from the pair that
  48 -- has most fun and concat them all.
  49 nextLevel :: Employee -> [(GuestList, GuestList)] -> (GuestList, GuestList)
  50 nextLevel e lst =
  51     let withBoss = glCons e $ mconcat $ map snd lst
  52         withoutBoss = mconcat $ map (uncurry moreFun) lst
  53     in
  54       (withBoss, withoutBoss)
  55
  56 -- exercise 4
  57 -- maxFun
  58 maxFun :: Tree Employee -> GuestList
  59 maxFun = uncurry moreFun . maxFunPair
  60
  61 maxFunPair :: Tree Employee -> (GuestList, GuestList)
  62 maxFunPair (Node e es) = nextLevel e $ map maxFunPair es
  63
  64 -- exercise 5
  65 -- main
  66
  67 sortedGL :: GuestList -> (Integer, [String])
  68 sortedGL (GL empls funval) = (funval, L.sort $ map empName empls)
  69
  70 getEmployeeList :: String -> String
  71 getEmployeeList empls = let (f, ls) = sortedGL (maxFun (read empls))
  72                         in
  73                           unlines $ show f : ls
  74
  75 main :: IO ()
  76 main = do
  77   empls <- readFile "company.txt"
  78   putStrLn $ getEmployeeList empls