{- |
    Module      :  $Header$
    Description :  Monads for message handling
    Copyright   :  2014 - 2016 Björn Peemöller
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental

    The monads defined in this module provide a common way to stop execution
    when some errors occur. They are used to integrate different compiler passes
    smoothly.
-}

module Curry.Base.Monad
  ( CYIO, CYM, CYT, failMessages, failMessageAt, warnMessages, warnMessageAt
  , ok, runCYIO, runCYM, runCYIOIgnWarn, runCYMIgnWarn, liftCYM, silent
  ) where

import Control.Monad.Identity
import Control.Monad.Trans.Except (ExceptT, mapExceptT, runExceptT, throwE)
import Control.Monad.Writer

import Curry.Base.Message  (Message, spanMessage)
import Curry.Base.Span (Span)
import Curry.Base.Pretty   (text)

-- |Curry compiler monad transformer
type CYT m a = WriterT [Message] (ExceptT [Message] m) a

-- |Curry compiler monad based on the `IO` monad
type CYIO a = CYT IO a

-- |Pure Curry compiler monad
type CYM a = CYT Identity a

-- |Run an `IO`-based Curry compiler action in the `IO` monad,
-- yielding either a list of errors or a result in case of success
-- consisting of the actual result and a (possibly empty) list of warnings
runCYIO :: CYIO a -> IO (Either [Message] (a, [Message]))
runCYIO :: CYIO a -> IO (Either [Message] (a, [Message]))
runCYIO = ExceptT [Message] IO (a, [Message])
-> IO (Either [Message] (a, [Message]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Message] IO (a, [Message])
 -> IO (Either [Message] (a, [Message])))
-> (CYIO a -> ExceptT [Message] IO (a, [Message]))
-> CYIO a
-> IO (Either [Message] (a, [Message]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CYIO a -> ExceptT [Message] IO (a, [Message])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT

-- |Run an pure Curry compiler action,
-- yielding either a list of errors or a result in case of success
-- consisting of the actual result and a (possibly empty) list of warnings
runCYM :: CYM a -> Either [Message] (a, [Message])
runCYM :: CYM a -> Either [Message] (a, [Message])
runCYM = Identity (Either [Message] (a, [Message]))
-> Either [Message] (a, [Message])
forall a. Identity a -> a
runIdentity (Identity (Either [Message] (a, [Message]))
 -> Either [Message] (a, [Message]))
-> (CYM a -> Identity (Either [Message] (a, [Message])))
-> CYM a
-> Either [Message] (a, [Message])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT [Message] Identity (a, [Message])
-> Identity (Either [Message] (a, [Message]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Message] Identity (a, [Message])
 -> Identity (Either [Message] (a, [Message])))
-> (CYM a -> ExceptT [Message] Identity (a, [Message]))
-> CYM a
-> Identity (Either [Message] (a, [Message]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CYM a -> ExceptT [Message] Identity (a, [Message])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT

-- |Run an `IO`-based Curry compiler action in the `IO` monad,
-- yielding either a list of errors or a result in case of success.
runCYIOIgnWarn :: CYIO a -> IO (Either [Message] a)
runCYIOIgnWarn :: CYIO a -> IO (Either [Message] a)
runCYIOIgnWarn = ExceptT [Message] IO a -> IO (Either [Message] a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Message] IO a -> IO (Either [Message] a))
-> (CYIO a -> ExceptT [Message] IO a)
-> CYIO a
-> IO (Either [Message] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, [Message]) -> a)
-> ExceptT [Message] IO (a, [Message]) -> ExceptT [Message] IO a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, [Message]) -> a
forall a b. (a, b) -> a
fst) (ExceptT [Message] IO (a, [Message]) -> ExceptT [Message] IO a)
-> (CYIO a -> ExceptT [Message] IO (a, [Message]))
-> CYIO a
-> ExceptT [Message] IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CYIO a -> ExceptT [Message] IO (a, [Message])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT

-- |Run an pure Curry compiler action,
-- yielding either a list of errors or a result in case of success.
runCYMIgnWarn :: CYM a -> Either [Message] a
runCYMIgnWarn :: CYM a -> Either [Message] a
runCYMIgnWarn = Identity (Either [Message] a) -> Either [Message] a
forall a. Identity a -> a
runIdentity (Identity (Either [Message] a) -> Either [Message] a)
-> (CYM a -> Identity (Either [Message] a))
-> CYM a
-> Either [Message] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT [Message] Identity a -> Identity (Either [Message] a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Message] Identity a -> Identity (Either [Message] a))
-> (CYM a -> ExceptT [Message] Identity a)
-> CYM a
-> Identity (Either [Message] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, [Message]) -> a)
-> ExceptT [Message] Identity (a, [Message])
-> ExceptT [Message] Identity a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, [Message]) -> a
forall a b. (a, b) -> a
fst) (ExceptT [Message] Identity (a, [Message])
 -> ExceptT [Message] Identity a)
-> (CYM a -> ExceptT [Message] Identity (a, [Message]))
-> CYM a
-> ExceptT [Message] Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CYM a -> ExceptT [Message] Identity (a, [Message])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT

-- |Failing action with a message describing the cause of failure.
failMessage :: Monad m => Message -> CYT m a
failMessage :: Message -> CYT m a
failMessage msg :: Message
msg = [Message] -> CYT m a
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message
msg]

-- |Failing action with a list of messages describing the cause(s) of failure.
failMessages :: Monad m => [Message] -> CYT m a
failMessages :: [Message] -> CYT m a
failMessages = ExceptT [Message] m a -> CYT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT [Message] m a -> CYT m a)
-> ([Message] -> ExceptT [Message] m a) -> [Message] -> CYT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Message] -> ExceptT [Message] m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

-- |Failing action with a source code span and a `String` indicating
-- the cause of failure.
failMessageAt :: Monad m => Span -> String -> CYT m a
failMessageAt :: Span -> String -> CYT m a
failMessageAt sp :: Span
sp s :: String
s = Message -> CYT m a
forall (m :: * -> *) a. Monad m => Message -> CYT m a
failMessage (Message -> CYT m a) -> Message -> CYT m a
forall a b. (a -> b) -> a -> b
$ Span -> Doc -> Message
spanMessage Span
sp (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s

-- |Warning with a message describing the cause of the warning.
warnMessage :: Monad m => Message -> CYT m ()
warnMessage :: Message -> CYT m ()
warnMessage msg :: Message
msg = [Message] -> CYT m ()
forall (m :: * -> *). Monad m => [Message] -> CYT m ()
warnMessages [Message
msg]

-- |Warning with a list of messages describing the cause(s) of the warnings.
warnMessages :: Monad m => [Message] -> CYT m ()
warnMessages :: [Message] -> CYT m ()
warnMessages msgs :: [Message]
msgs = [Message] -> CYT m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Message]
msgs

-- |Execute a monadic action, but ignore any warnings it issues
silent :: Monad m => CYT m a -> CYT m a
silent :: CYT m a -> CYT m a
silent act :: CYT m a
act = ([Message] -> [Message]) -> CYT m a -> CYT m a
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ([Message] -> [Message] -> [Message]
forall a b. a -> b -> a
const []) CYT m a
act

-- |Warning with a source code position and a `String` indicating
-- the cause of the warning.
warnMessageAt :: Monad m => Span -> String -> CYT m ()
warnMessageAt :: Span -> String -> CYT m ()
warnMessageAt sp :: Span
sp s :: String
s = Message -> CYT m ()
forall (m :: * -> *). Monad m => Message -> CYT m ()
warnMessage (Message -> CYT m ()) -> Message -> CYT m ()
forall a b. (a -> b) -> a -> b
$ Span -> Doc -> Message
spanMessage Span
sp (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s

-- |Lift a value into the `CYT m` monad, same as `return`.
ok :: Monad m => a -> CYT m a
ok :: a -> CYT m a
ok = a -> CYT m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- |Lift a pure action into an action based on another monad.
liftCYM :: Monad m => CYM a -> CYT m a
liftCYM :: CYM a -> CYT m a
liftCYM = (ExceptT [Message] Identity (a, [Message])
 -> ExceptT [Message] m (a, [Message]))
-> CYM a -> CYT m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((Identity (Either [Message] (a, [Message]))
 -> m (Either [Message] (a, [Message])))
-> ExceptT [Message] Identity (a, [Message])
-> ExceptT [Message] m (a, [Message])
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (Either [Message] (a, [Message])
-> m (Either [Message] (a, [Message]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Message] (a, [Message])
 -> m (Either [Message] (a, [Message])))
-> (Identity (Either [Message] (a, [Message]))
    -> Either [Message] (a, [Message]))
-> Identity (Either [Message] (a, [Message]))
-> m (Either [Message] (a, [Message]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Either [Message] (a, [Message]))
-> Either [Message] (a, [Message])
forall a. Identity a -> a
runIdentity))