Haskell Dynamic Programming on a Tree

Question

Here is my shot at Homework 8 of CIS-194 (from Spring '13). The problem is about a hierarchy of employees at a company (a tree), each node being of type Employee, each described by a label (empName :: String) and an integer value (empFun :: Integer). We need to choose a subset of employees so that no two chosen employees have a parent-child relationship within the tree and the sum of empFuns of the chosen employees is maximised.

Some of the outline and structure of this code is based on what was suggested by the document, but I am curious to know if the rest of it is consistent and idiomatic Haskell. I'm not sure what I'm expecting as feedback, but any is welcome.

module Party where
 
import Data.List ( sort )
import Data.Tree ( Tree(Node) )
import Employee ( Employee(empFun, empName), Fun, GuestList(..) )
instance Semigroup GuestList where 
 (GL a b) <> (GL c d) = GL (a ++ c) (b + d)
instance Monoid GuestList where
 mempty = GL [] 0
glCons :: Employee -> GuestList -> GuestList
glCons emp (GL a b) = GL (a ++ [emp]) (empFun emp)
moreFun :: GuestList -> GuestList -> GuestList 
moreFun = max
treeFold :: (a -> [b] -> b) -> Tree a -> b
treeFold f (Node label subtree) = f label (map (treeFold f) subtree) 
nextLevel :: Employee -> [(GuestList, GuestList)] -> (GuestList, GuestList)
nextLevel emp subList = (glCons emp (foldMap snd subList), foldMap (uncurry max) subList)
maxFun :: Tree Employee -> GuestList 
maxFun tree = uncurry moreFun $ treeFold nextLevel tree
getFormattedGL :: GuestList -> String 
getFormattedGL gl = unlines (("Total fun " ++ show (fun gl)) : sort (map empName (emps gl)))
 where fun (GL _ fun) = fun
 emps (GL emps _) = emps
work :: [Char] -> String
work = getFormattedGL . maxFun . read
main :: IO ()
main = readFile "company.txt" >>= putStrLn . work

• P.K.: @bisserlis "Employee" in my post is a URL that leads to the file cis.upenn.edu/~cis194/spring13/extras/08-IO/Employee.hs
• bisserlis: Oops! Somehow I glossed right over that.

Answer 1

Unfortunately, there is a bug in glCons. The employee's fun should get added, not replace the current fun level:

glCons :: Employee -> GuestList -> GuestList
glCons emp (GL a b) = GL (a ++ [emp]) (empFun emp)
 -- ^

But let's stay on glCons. We can expect glCons to be used via foldr. However, the ++ operator leads to quadratic behaviour. When we add a single element, we should therefore use (:) (and reverse, if the order matters):

glCons :: Employee -> GuestList -> GuestList
glCons emp (GL a b) = GL (emp : a) (empFun emp + b)

Other than that the code seems fine.