{-# LANGUAGE TemplateHaskell #-}

module MonadLab.IoList (
   ioListMonad
 ) where

import Prelude hiding (Monad)
import qualified Control.Monad
import Language.Haskell.TH
import MonadLab.CommonTypes

ioListMonad :: Monad
ioListMonad = (ioListTypeCon , ioListReturn , ioListBind, [(Io, [liftIO]), (List, [merge])], ioListBaseLift)

ioListTypeCon :: MonadTypeCon
ioListTypeCon = \t -> appT (conT ''IO) (appT listT t) 

ioListReturn :: ReturnExpQ
ioListReturn = [| return . (\x -> [x]) |]

ioListBind :: BindExpQ
ioListBind = [| \m -> \f -> m >>= \vs ->
			    Control.Monad.mapM f vs >>= \vs's ->
			    return (concat vs's) |]

liftIO :: NonProperMorphismExpQ
liftIO = [| \io -> io >>= \v -> return [v] |]

merge :: NonProperMorphismExpQ
merge = [| (\m -> $ioListBind m id) . return |]

ioListBaseLift :: LiftExpQ
ioListBaseLift = [| return |]