{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}

-- | Module      : Control.Monad.Sharing.Classes
-- | Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer
-- | License     : PublicDomain
-- |
-- | Maintainer  : Sebastian Fischer (sebf@informatik.uni-kiel.de)
-- | Stability   : experimental
-- |
-- | This library provides type classes for explicit sharing of
-- | monadic effects.
module Control.Monad.Sharing.Classes (

  Sharing(..), 

  -- | We provide instances of the @Trans@ class for some predefined
  -- | Haskell types. For flat types the function @trans@ just returns
  -- | its argument which has no arguments to which the given function
  -- | could be applied.

  Trans(..), eval

 ) where

import Control.Monad ( liftM, join )

-- | Interface of monads that support explicit sharing.
class Sharing m
 where
  -- | Yields an action that returns the same results as the given
  -- | action but whose effects are only executed once. Especially,
  -- | when the resulting action is duplicated it returns the same
  -- | result at every occurrence.
  share :: Trans m a a => m a -> m (m a)

-- | Interface to transform nested monadic data types. The provided
-- | function @trans@ is supposed to map the given function on every
-- | monadic argument. The result of @trans@ may be of the same type
-- | as the argument but can also be of a different type, e.g. to
-- | convert a value with nested monadic arguments to a corresponding
-- | value without.
class Trans m a b
 where
  trans :: (forall c d . Trans m c d => m c -> m (m d)) -> a -> m b

-- | Lifts all monadic effects in nested monadic values to the top
-- | level. If @m@ is a monad for non-determinism and the argument a
-- | data structure with nested non-determinism then the result
-- | corresponds to the normal form of the argument.
eval :: (Monad m, Trans m a b) => a -> m b
eval = trans (\a -> liftM return (a >>= eval))

instance Monad m => Trans m Bool Bool
 where
  trans _ = return

instance Monad m => Trans m Int Int
 where
  trans _ = return

instance Monad m => Trans m Char Char
 where
  trans _ = return

instance Monad m => Trans m Float Float
 where
  trans _ = return

instance Monad m => Trans m Double Double
 where
  trans _ = return

instance Monad m => Trans m [Bool] [Bool]
 where
  trans _ = return

instance Monad m => Trans m [Int] [Int]
 where
  trans _ = return

instance Monad m => Trans m [Char] [Char]
 where
  trans _ = return

instance Monad m => Trans m [Float] [Float]
 where
  trans _ = return

instance Monad m => Trans m [Double] [Double]
 where
  trans _ = return

-- | An instance for lists with monadic elements.
instance (Monad m, Trans m a a) => Trans m [m a] [m a]
 where
  trans f = mapM f

-- | An instance for lists with monadic elements that lifts all
-- | monadic effects to the top level and yields a list with
-- | non-monadic elements.
instance (Monad m, Trans m a a) => Trans m [m a] [a]
 where
  trans f = mapM (join . f)