Consuming keys from a json object

Consuming.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Yaml.Extended (module Data.Yaml.Extended, lift) where

import Data.Yaml
import qualified Data.Text as T
import Control.Monad.State.Strict (StateT, runStateT, unless, lift, get, modify)
import qualified Data.HashMap.Strict as HM (null, delete, keys)
import Data.List (intercalate)

useKey :: FromJSON v => T.Text -> StateT Object Parser v
useKey k = do o <- get
              v <- lift (o .: k)
              modify (HM.delete k)
              return v

failUnlessEmpty :: StateT Object Parser x -> Object -> Parser x
failUnlessEmpty sm o = do (x, o') <- runStateT sm o
                          unless (HM.null o') (failWithExtra (HM.keys o'))
                          return x

failWithExtra :: (Monad m, Show a) => [a] -> m ()
failWithExtra unused = fail ("Unhandled fields in JSON object: " ++ v unused)
              where v = intercalate ", " . map show

ex1 :: Object -> Parser (String, Int)
ex1 = failUnlessEmpty $ do v <- useKey "name"
                           x <- useKey "age"
                           return (v, x)