Zooming StateT with return value in indexed container

I'm having trouble figuring out the cleanest way of zooming an effect like StateT that returns a value into an indexed container like a vector or a map.

For example let's say I have some structures for a card game:

data Card = Card
    { cardValue :: Int
    } deriving (Show, Eq)
makeFields ''Card

data Player = Player
    { playerCards :: [Card]
    } deriving (Show, Eq)
makeFields ''Player

data Game = Game
    { gamePlayers :: M.Map Int Player
    } deriving (Show, Eq)
makeFields ''Game

data Action = GiveCard Card | DoNothing

And a function that handles a player's move in a turn with a StateT effect:

playerAction :: (MonadIO m) => StateT Player m Action
playerAction = do
    cards' <- use cards
    case cards' of
        (c:rest) -> GiveCard c <$ (cards .= rest)
        _        -> return DoNothing

What I want to do is to index inside a player in the game and apply this StateT to that player. Something that looks like this:

gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
    Just action <- zoom (players . at i . mapJust) playerAction
    case action of
        GiveCard c -> liftIO $ print c
        DoNothing  -> liftIO $ putStrLn "Doing nothing"

Adding _Just in the traversal or replacing at i with ix i results in this compile error:

    • Could not deduce (Monoid Action) arising from a use of ‘_Just’
      from the context: MonadIO m
        bound by the type signature for:
                   gameAction :: forall (m :: * -> *).
                                 MonadIO m =>
                                 Int -> StateT Game m ()
        at src/MainModule.hs:36:1-52
    • In the second argument of ‘(.)’, namely ‘_Just’
      In the second argument of ‘(.)’, namely ‘at i . _Just’
      In the first argument of ‘zoom’, namely ‘(players . at i . _Just)’
   |
38 |     action <- zoom (players . at i . _Just) playerAction
   |                                      ^^^^^

I could use non with a dummy Player value but if the index doesn't exist then it silently runs the function on the dummy value which is not what I want:

emptyPlayer :: Player
emptyPlayer = Player []

gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
    action <- zoom (players . at i . non emptyPlayer) playerAction
    case action of
        GiveCard c -> liftIO $ print c
        DoNothing  -> liftIO $ putStrLn "Doing nothing"

I could grab the player out with preuse, modify it and set the modified value. Calling the function that does this is pretty verbose since it has to take in the runMonad function and the getter and setter lenses.

prezoom run get set m = do
    maybeS <- preuse get
    case maybeS of
        Just s -> do
            (r, s') <- lift $ run m s
            set .= s'
            return $ Just r
        Nothing -> return Nothing

gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
    Just action <- prezoom runStateT (players . ix i) (players . ix i) playerAction
    case action of
        GiveCard c -> liftIO $ print c
        DoNothing  -> liftIO $ putStrLn "Doing nothing"

I don't really like the above ways of zooming into an indexed container. Is there an easier and cleaner way to do this?

Solution

It sounds like you have a handle on what the underlying semantic issue is, but let me restate it for clarity.

at i is a Lens into a container which returns a Maybe, because the item may be missing from the container (perhaps the index is beyond the end of the list). Composing such a Lens with a Prism like _Just turns the whole thing into a Traversal:

players . at i . _Just :: Traversal' Game Player

Now, zoom does work with Traversals, but it needs a Monoid for the return value of the stateful action. From the docs:

When applied to a Traversal' over multiple values, the actions for each target are executed sequentially and the results are aggregated.

A Traversal may return zero-or-many results, so zoom will execute the monadic action zero-or-many times, filling in mempty as a default value and combining multiple results with mappend. The docs also feature the following specialised type signature for zoom, which demonstrates the Monoid constraint:

zoom :: (Monad m, Monoid c) => Traversal' s t -> StateT t m c -> StateT s m c

That’s why your error message says “Could not deduce (Monoid Action)”: playerAction returns an Action and zoom needs a Monoid for Action because you handed it a Traversal.

So the fix is to pick a Monoid to return from the stateful action. We know that the Traversal will either hit one or zero targets - at i never returns multiple results - so the correct semantics for the Monoid we’re looking for are “first-result-or-failure”. That Monoid is First. (We don’t need to worry about throwing away extra results because there won’t be any.)

action <- getFirst <$> zoom (players . at i . _Just) (fmap (First . Just) playerAction)
-- here action :: Maybe Action

(I’m on my phone so I haven’t tested this code!) You might be able to clean this up a bit using ala.