{-# LANGUAGE TupleSections, NoMonomorphismRestriction #-}
-- |A module extending the functionality of the State Monad with Views
module Control.Monad.State.View (
  module Control.Monad.State,
  module Data.View,
  -- * Views with State
  viewState
  ,viewing,modifying,getting,putting
  ,swappingWith,swapping
  ,saving
  ) where

import Data.View
import Control.Monad.State

-- | Constructs a State monad that acts on a View.
viewState (View v v') run = state (\s -> let ~(x,s') = run (v s) in (x,v' s' s))
-- | Executes a state restricted to the given View.
viewing v st              = viewState v (runState st)
-- | Modifies the view by the given function. @modifying v f@ is equivalent to @viewing v (modify f)@.
modifying v f             = viewState v (\s -> ((),f s))
-- | Gets the given view from the whole state
getting v                 = gets (extract v)
-- | Injects the given value into the whole state. @putting v x@ is equivalent to @viewing v (put x)@.
putting f v               = modifying f (const v)

-- | @saving v m@ executes @m@, while preserving the value of the View @v@.
saving v m = getting v >>= \x -> m >>= \m -> putting v x >> return m

-- | @swappingWith v f m@ executes @m@ in an environment where the view @v@ was modified by @f@,
-- preserving the old value of @v@ (it swaps the old value and the new, and then swaps back after @m@)
swappingWith v f m = saving v (modifying v f >> m)

-- | A special case of 'swappingWith' with a constant value.
swapping v s = swappingWith v (const s)