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, posMessage)
import Curry.Base.Position
import Curry.Base.Pretty (text)
type CYT m a = WriterT [Message] (ExceptT [Message] m) a
type CYIO a = CYT IO a
type CYM a = CYT Identity a
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
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
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
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
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]
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
failMessageAt :: Monad m => Position -> String -> CYT m a
failMessageAt :: Position -> String -> CYT m a
failMessageAt pos :: Position
pos 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
$ Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
pos (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
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]
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
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
warnMessageAt :: Monad m => Position -> String -> CYT m ()
warnMessageAt :: Position -> String -> CYT m ()
warnMessageAt pos :: Position
pos 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
$ Position -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Position
pos (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
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
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))