{-# OPTIONS -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}


-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.StateX.Class
-- Copyright   :  (c) Mark Snyder 2008.
-- License     :  BSD-style
-- Maintainer  :  Mark Snyder, marks@ittc.ku.edu
-- Stability   :  experimental
-- Portability :  non-portable (multi-param classes, functional dependencies)

-----------------------------------------------------------------------------

module Control.Monad.StateX.Class (
    MonadStateX(..),
    modifyx,
    getsx,
  ) where

import Control.Monad.Index

-- ---------------------------------------------------------------------------
-- | /get/ returns the state from the internals of the monad.
--
-- /put/ replaces the state inside the monad.

class (Monad m, Index ix) => MonadStateX ix s m | ix m -> s where
    getx :: ix -> m s
    putx :: ix -> s -> m ()

-- | Monadic state transformer.
--
--      Maps an old state to a new state inside a state monad.
--      The old state is thrown away.
--
-- >      Main> :t modify ((+1) :: Int -> Int)
-- >      modify (...) :: (MonadState Int a) => a ()
--
--    This says that @modify (+1)@ acts over any
--    Monad that is a member of the @MonadState@ class,
--    with an @Int@ state.

modifyx :: (MonadStateX ix s m) => ix -> (s -> s) -> m ()
modifyx ix f = do
    s <- getx ix
    putx ix (f s)

-- | Gets specific component of the state, using a projection function
-- supplied.

getsx :: (MonadStateX ix s m) => ix -> (s -> a) -> m a
getsx ix f = do
    s <- getx ix
    return (f s)