Class.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Control.Monad.TransLogicState.Class
  ( TransLogicState(..)
  
  , observe
  , observeAll
  , observeMany
  )
  where

-- import Data.Typeable

import Control.Arrow
import Control.Monad.Identity
-- import Control.Monad.Trans

-- | Additions to MonadTrans specifically useful for LogicState
class {- MonadTrans t => -} TransLogicState s t where
  -------------------------------------------------------------------------
  -- | Extracts the first result from a 't m' computation,
  -- failing otherwise.
  observeT :: (Monad m) => s -> t m a -> m a
  observeT e m = fmap head $ observeManyT e 1 m
  
  -------------------------------------------------------------------------
  -- | Extracts all results from a 't m' computation.
  observeAllT :: (Monad m) => s -> t m a -> m [a]
  observeAllT e = fmap fst . observeStateAllT e
  
  -------------------------------------------------------------------------
  -- | Extracts all results from a 't m' computation.
  observeStateAllT :: (Monad m) => s -> t m a -> m ([a],s)
  observeStateAllT e = observeStateManyT e maxBound
  
  -------------------------------------------------------------------------
  -- | Extracts up to a given number of results from a 't m' computation.
  observeManyT :: forall m a . (Monad m) => s -> Int -> t m a -> m [a]
  observeManyT e n m = fmap fst $ observeStateManyT e n m

  -------------------------------------------------------------------------
  -- | Extracts up to a given number of results from a 't m' computation.
  observeStateManyT :: forall m a . (Monad m) => s -> Int -> t m a -> m ([a],s)
  observeStateManyT e n m = fmap (first $ take n) $ observeStateAllT e m

  -- | Lift a monad by threading the state available in the transformed monad through it
  liftWithState :: Monad m => (s -> m (a,s)) -> t m a

-------------------------------------------------------------------------
-- | Extracts the first result from a LogicVar computation.
observe :: (TransLogicState s t) => s -> t Identity a -> a
observe e = runIdentity . observeT e

-------------------------------------------------------------------------
-- | Extracts all results from a LogicVar computation.
observeAll :: (TransLogicState s t) => s -> t Identity a -> [a]
observeAll e = runIdentity . observeAllT e

-------------------------------------------------------------------------
-- | Extracts up to a given number of results from a LogicVar computation.
observeMany :: (TransLogicState s t) => s -> Int -> t Identity a -> [a]
observeMany e i = runIdentity . observeManyT e i