Search code examples
haskellstate-monad

Haskell: put in State monad seems to be elided


I'm writing a program to allocate pizzas to people; each person will get one pizza, ideally of their favorite type, unless stock has run out, in which case they are given their next favorite type recursively.

My approach is to compute a ((User, Pizza), Int) for the amount a person would like said pizza, sort those, and recurse through using a state monad to keep inventory counts.

The program is written and type checks:

allocatePizzasImpl :: [((User, Pizza), Int)] 
                   -> State [(Pizza, Int)] [(User, Pizza)]
allocatePizzasImpl [] = return []
allocatePizzasImpl ((user, (flavor, _)):ranks) =
    do inventory <- get
       -- this line is never hit
       put $ updateWith inventory (\i -> if i <= 0
                                         then Nothing
                                         else Just $ i - 1) flavor
       next <- allocatePizzasImpl $ filter ((/= user) . fst) ranks
       return $ (user, flavor) : next

and I have a helper function to extract the result:

allocatePizzas :: [Pizza] 
               -> [((User, Pizza), Int)] 
               -> [(User, Pizza)]
allocatePizzas pizzas rank = fst 
                           . runState (allocatePizzasImpl rank) 
                           $ buildQuotas pizzas

but the line indicated by -- this line is never hit is... never hit by any GHCI breakpoints; furthermore, if I break on the return call, GHCI says inventory isn't in scope.

When run, the result is assigning the same pizza (with one inventory count) to all users. Something is going wrong, but I have absolutely no idea how to proceed. I'm new to Haskell, so any comments on style would be appreciated as well =)

Thanks!

PS: For completeness, updateWith is defined as:

updateWith :: (Eq a, Eq b) 
           => [(a, b)]        -- inventory
           -> (b -> Maybe b)  -- update function; Nothing removes it
           -> a               -- key to update
           -> [(a, b)]
updateWith set update key =
    case lookup key set of
      Just b -> replace set
                        (unwrapPair (key, update b))
                        (fromMaybe 0 $ elemIndex (key, b) set)
      Nothing -> set
  where replace :: [a] -> Maybe a -> Int -> [a]
        replace [] _ _ = []
        replace (_:xs) (Just val) 0 = val:xs
        replace (_:xs) Nothing 0 = xs
        replace (x:xs) val i = x : (replace xs val $ i - 1)

        unwrapPair :: Monad m => (a, m b) -> m (a, b)
        unwrapPair (a, mb) = do b <- mb
                                return (a, b)

Solution

  • I think your function replace is broken:

    replace (_:xs) (Just val) 0 = val:xs
    

    This doesn't pay any attention to the value it's replacing. Wasn't your intention to replace just the pair corresponding to key?

    I think you want

    updateWith [] e k = []
    updateWith ((k', v):kvs) e k
        | k' == k = case e v of
            Just v' -> (k, v'):kvs
            Nothing -> kvs
        | otherwise = (k', v) : updateWith kvs e k