{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}
{- Deep Monadic Join
The regular `join' function, defined in Control.Monad, has the
signature
join :: Monad m => m (m a) -> m a
Paolo Martini (in his message on Apr 26, 2006) posed the problem of
a deep join function:
deep'join :: Monad m => m (m (m (... a ...))) -> m a
Note, generally speaking we cannot remove the last 'm': some monads, for
example IO, do not provide any function of the type |m a -> a|.
One may say that deep'join is a `folded' join. For the List monad,
deep join is list flattening.
The idea of the code is explained in typecast.html
in this directory.
-}
import Control.Monad (join)
import Data.IORef -- needed for tests only
class Monad m => DeepJoin mv m a | mv -> m a where
deep'join :: mv -> m a
instance (IsNestedMonad mv flag, Monad m, DeepJoin' flag mv m a)
=> DeepJoin mv m a where
deep'join = deep'join' (undefined::flag)
class Monad m => DeepJoin' flag mv m a | flag mv -> m a where
deep'join' :: flag -> mv -> m a
instance Monad m => DeepJoin' HFalse (m a) m a where
deep'join' _ = id
instance (Monad m, DeepJoin (m mv) m a)
=> DeepJoin' HTrue (m (m mv)) m a where
deep'join' _ = deep'join . join
-- The following is almost equivalent to IsFunction.lhs
data HTrue
data HFalse
class IsNestedMonad m b | m -> b
instance TypeCast f HTrue => IsNestedMonad (m (m a)) f
instance TypeCast f HFalse => IsNestedMonad m f
class TypeCast a b | a -> b, b->a where typeCast :: a -> b
class TypeCast' t a b | t a -> b, t b -> a where typeCast' :: t->a->b
class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
instance TypeCast' () a b => TypeCast a b where typeCast x = typeCast' () x
instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
instance TypeCast'' () a a where typeCast'' _ x = x
------------------------------------------ Tests
testv1 = returnIO (returnIO (returnIO (newIORef True)))
where returnIO :: forall a. a -> IO a
returnIO = return
-- :t testv1
-- testv1 :: IO (IO (IO (IO (IORef Bool))))
test1 = deep'join testv1 >>= readIORef >>= print
-- The following understandably doesn't work: the literal 1 actually
-- represents fromInteger 1, whose result may well be a list
-- (one can define an instance of Num for a list). So, deep'join can't figure
-- out to what extent flatten the list (that is, the monad). Some help
-- is needed.
-- test2 = deep'join [[[[1],[]]]]
-- For example, we can instantiate types...
test3 = deep'join [[[[1::Int],[2],[3,4]],[[5],[6]]]]
-- The following demonstrates that if enough type information is available
-- to figure out the extent of the deep joining, we can handle polymorphic
-- monads.
test4 :: [Maybe a] -- signature is needed for the monomorphism restriction
test4 :: [Maybe a] = deep'join [[[[Nothing::Maybe a]]]]