{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Language.PureScript.Make.Monad
(
Make(..)
, runMake
, makeIO
, readTextFile
) where
import Prelude
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader (MonadReader(..), ReaderT(..))
import Control.Monad.Trans.Control (MonadBaseControl(..))
import Control.Monad.Trans.Except
import Control.Monad.Writer.Class (MonadWriter(..))
import qualified Data.ByteString.Lazy as B
import Language.PureScript.AST
import Language.PureScript.Errors
import Language.PureScript.Options
import System.IO.Error (tryIOError)
newtype Make a = Make
{ unMake :: ReaderT Options (ExceptT MultipleErrors (Logger MultipleErrors)) a
} deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)
instance MonadBase IO Make where
liftBase = liftIO
instance MonadBaseControl IO Make where
type StM Make a = Either MultipleErrors a
liftBaseWith f = Make $ liftBaseWith $ \q -> f (q . unMake)
restoreM = Make . restoreM
runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake
makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a
makeIO f io = do
e <- liftIO $ tryIOError io
either (throwError . singleError . f) return e
readTextFile :: FilePath -> Make B.ByteString
readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ B.readFile path