{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} module Data.Markup.Types where import Control.Applicative import Control.Monad import Control.Monad.Trans import Control.Monad.Reader.Class -- | Mirror of the ReaderT monad transformer - used to coerce markup to /inline/ -- rendering. newtype InlineMarkupT i m a = InlineMarkupT { runInlineMarkupT :: i -> m a } deriving (Functor) instance Applicative f => Applicative (InlineMarkupT i f) where (<*>) f x = InlineMarkupT $ \i -> (<*>) (runInlineMarkupT f i) (runInlineMarkupT x i) instance Alternative f => Alternative (InlineMarkupT i f) where (<|>) m n = InlineMarkupT $ \i -> (<|>) (runInlineMarkupT m i) (runInlineMarkupT n i) instance Monad m => Monad (InlineMarkupT i m) where return x = InlineMarkupT $ \_ -> return x (>>=) x f = InlineMarkupT $ \i -> runInlineMarkupT x i >>= \y -> runInlineMarkupT (f y) i instance MonadPlus m => MonadPlus (InlineMarkupT i m) where mzero = lift mzero x `mplus` y = InlineMarkupT $ \i -> (runInlineMarkupT x i) `mplus` (runInlineMarkupT y i) instance MonadTrans (InlineMarkupT i) where lift x = InlineMarkupT $ \_ -> x instance Monad m => MonadReader i (InlineMarkupT i m) where ask = InlineMarkupT $ \i -> return i -- | Mirror of the ReaderT monad transformer - used to coerce markup to /hosted/ -- rendering. newtype HostedMarkupT i m a = HostedMarkupT { runHostedMarkupT :: i -> m a } deriving (Functor) instance Applicative f => Applicative (HostedMarkupT i f) where (<*>) f x = HostedMarkupT $ \i -> (<*>) (runHostedMarkupT f i) (runHostedMarkupT x i) instance Alternative f => Alternative (HostedMarkupT i f) where (<|>) m n = HostedMarkupT $ \i -> (<|>) (runHostedMarkupT m i) (runHostedMarkupT n i) instance Monad m => Monad (HostedMarkupT i m) where return x = HostedMarkupT $ \_ -> return x (>>=) x f = HostedMarkupT $ \i -> runHostedMarkupT x i >>= \y -> runHostedMarkupT (f y) i instance MonadPlus m => MonadPlus (HostedMarkupT i m) where mzero = lift mzero x `mplus` y = HostedMarkupT $ \i -> (runHostedMarkupT x i) `mplus` (runHostedMarkupT y i) instance MonadTrans (HostedMarkupT i) where lift x = HostedMarkupT $ \_ -> x instance Monad m => MonadReader i (HostedMarkupT i m) where ask = HostedMarkupT $ \i -> return i -- | Mirror of the ReaderT monad transformer - used to coerce markup to /local/ -- rendering. newtype LocalMarkupT i m a = LocalMarkupT { runLocalMarkupT :: i -> m a } deriving (Functor) instance Applicative f => Applicative (LocalMarkupT i f) where (<*>) f x = LocalMarkupT $ \i -> (<*>) (runLocalMarkupT f i) (runLocalMarkupT x i) instance Alternative f => Alternative (LocalMarkupT i f) where (<|>) m n = LocalMarkupT $ \i -> (<|>) (runLocalMarkupT m i) (runLocalMarkupT n i) instance Monad m => Monad (LocalMarkupT i m) where return x = LocalMarkupT $ \_ -> return x (>>=) x f = LocalMarkupT $ \i -> runLocalMarkupT x i >>= \y -> runLocalMarkupT (f y) i instance MonadPlus m => MonadPlus (LocalMarkupT i m) where mzero = lift mzero x `mplus` y = LocalMarkupT $ \i -> (runLocalMarkupT x i) `mplus` (runLocalMarkupT y i) instance MonadTrans (LocalMarkupT i) where lift x = LocalMarkupT $ \_ -> x instance Monad m => MonadReader i (LocalMarkupT i m) where ask = LocalMarkupT $ \i -> return i