-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}

-- |
-- Module      :  Cardano.CLI.Types.MonadWarning
--
-- This module defines the 'MonadWarning' type class, which provides a common
-- interface for monads that support reporting warning messages without
-- aborting the computation (unlike with exceptions, 'Either', or
-- 'MonadFail', which either fail or return a value).
--
-- It also includes two functions that instantiate it into either a 'MonadIO'
-- ('runWarningIO') or a 'StateT' monad with a @[String]@ as state
-- ('runWarningStateT') respectively.
--
-- In the case of 'MonadIO', warnings are printed to 'stderr'.
-- In the case of 'StateT', with a @[String]@ state, warnings are added to the
-- list in the state.
--
-- By using the 'MonadWarning' type class, users can write code that remains
-- agnostic to the specific monad in which it operates, and to easily change
-- it at a later stage if necessary.
--
-- Example usage:
--
-- @
-- computeWithWarning :: (MonadWarning m) => Int -> m Int
-- computeWithWarning x = do
--   when (x < 0) $ reportIssue "Input value is negative!"
--   return (x * 2)
--
-- -- Using 'IO' monad to perform computation and report warnings.
-- main :: IO ()
-- main = do
--   result <- runWarningIO $ computeWithWarning (-4)
--   putStrLn $ "Result: " ++ show result
-- @
module Cardano.CLI.Types.MonadWarning
  ( MonadWarning (..)
  , WarningIO
  , WarningStateT
  , eitherToWarning
  , runWarningIO
  , runWarningStateT
  )
where

import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.State (MonadState (..))
import           Control.Monad.Trans.State (StateT)
import           System.IO (hPutStrLn, stderr)

-- | Type class for monads that support reporting warnings without aborting
-- their execution in the process.
class Monad m => MonadWarning m where
  -- | Report a non-fatal issue.
  reportIssue
    :: String
    -- ^ The warning message to report.
    -> m ()
    -- ^ The action that reports the warning.

-- | Wrapper newtype for 'MonadIO' with 'MonadWarning' instance.
-- This type is not meant to be constructed directly but just to serve
-- as an instance of 'MonadWarning' that can be converted to 'MonadIO'.
-- It is only necessary in order to avoid overlapping instances.
newtype WarningIO m a = WarningIO
  { forall (m :: * -> *) a. WarningIO m a -> m a
runWarningIO :: m a
  -- ^ Interpret a 'MonadWarning' as a 'MonadIO' by reporting
  -- warnings to 'stderr'.
  }
  deriving ((forall a b. (a -> b) -> WarningIO m a -> WarningIO m b)
-> (forall a b. a -> WarningIO m b -> WarningIO m a)
-> Functor (WarningIO m)
forall a b. a -> WarningIO m b -> WarningIO m a
forall a b. (a -> b) -> WarningIO m a -> WarningIO m b
forall (m :: * -> *) a b.
Functor m =>
a -> WarningIO m b -> WarningIO m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WarningIO m a -> WarningIO m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WarningIO m a -> WarningIO m b
fmap :: forall a b. (a -> b) -> WarningIO m a -> WarningIO m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WarningIO m b -> WarningIO m a
<$ :: forall a b. a -> WarningIO m b -> WarningIO m a
Functor, Functor (WarningIO m)
Functor (WarningIO m) =>
(forall a. a -> WarningIO m a)
-> (forall a b.
    WarningIO m (a -> b) -> WarningIO m a -> WarningIO m b)
-> (forall a b c.
    (a -> b -> c) -> WarningIO m a -> WarningIO m b -> WarningIO m c)
-> (forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b)
-> (forall a b. WarningIO m a -> WarningIO m b -> WarningIO m a)
-> Applicative (WarningIO m)
forall a. a -> WarningIO m a
forall a b. WarningIO m a -> WarningIO m b -> WarningIO m a
forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b
forall a b. WarningIO m (a -> b) -> WarningIO m a -> WarningIO m b
forall a b c.
(a -> b -> c) -> WarningIO m a -> WarningIO m b -> WarningIO m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (WarningIO m)
forall (m :: * -> *) a. Applicative m => a -> WarningIO m a
forall (m :: * -> *) a b.
Applicative m =>
WarningIO m a -> WarningIO m b -> WarningIO m a
forall (m :: * -> *) a b.
Applicative m =>
WarningIO m a -> WarningIO m b -> WarningIO m b
forall (m :: * -> *) a b.
Applicative m =>
WarningIO m (a -> b) -> WarningIO m a -> WarningIO m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> WarningIO m a -> WarningIO m b -> WarningIO m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> WarningIO m a
pure :: forall a. a -> WarningIO m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WarningIO m (a -> b) -> WarningIO m a -> WarningIO m b
<*> :: forall a b. WarningIO m (a -> b) -> WarningIO m a -> WarningIO m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> WarningIO m a -> WarningIO m b -> WarningIO m c
liftA2 :: forall a b c.
(a -> b -> c) -> WarningIO m a -> WarningIO m b -> WarningIO m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WarningIO m a -> WarningIO m b -> WarningIO m b
*> :: forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WarningIO m a -> WarningIO m b -> WarningIO m a
<* :: forall a b. WarningIO m a -> WarningIO m b -> WarningIO m a
Applicative, Applicative (WarningIO m)
Applicative (WarningIO m) =>
(forall a b.
 WarningIO m a -> (a -> WarningIO m b) -> WarningIO m b)
-> (forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b)
-> (forall a. a -> WarningIO m a)
-> Monad (WarningIO m)
forall a. a -> WarningIO m a
forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b
forall a b. WarningIO m a -> (a -> WarningIO m b) -> WarningIO m b
forall (m :: * -> *). Monad m => Applicative (WarningIO m)
forall (m :: * -> *) a. Monad m => a -> WarningIO m a
forall (m :: * -> *) a b.
Monad m =>
WarningIO m a -> WarningIO m b -> WarningIO m b
forall (m :: * -> *) a b.
Monad m =>
WarningIO m a -> (a -> WarningIO m b) -> WarningIO m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WarningIO m a -> (a -> WarningIO m b) -> WarningIO m b
>>= :: forall a b. WarningIO m a -> (a -> WarningIO m b) -> WarningIO m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WarningIO m a -> WarningIO m b -> WarningIO m b
>> :: forall a b. WarningIO m a -> WarningIO m b -> WarningIO m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> WarningIO m a
return :: forall a. a -> WarningIO m a
Monad, Monad (WarningIO m)
Monad (WarningIO m) =>
(forall a. IO a -> WarningIO m a) -> MonadIO (WarningIO m)
forall a. IO a -> WarningIO m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (WarningIO m)
forall (m :: * -> *) a. MonadIO m => IO a -> WarningIO m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> WarningIO m a
liftIO :: forall a. IO a -> WarningIO m a
MonadIO)

-- | This instance prints the issue to 'stderr'.
instance MonadIO m => MonadWarning (WarningIO m) where
  reportIssue :: String -> WarningIO m ()
  reportIssue :: String -> WarningIO m ()
reportIssue String
issue = IO () -> WarningIO m ()
forall a. IO a -> WarningIO m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
issue)

-- | Wrapper newtype for @StateT [String]@ with 'MonadWarning' instance.
-- This type is not meant to be constructed directly but just to serve
-- as an instance of 'MonadWarning' that can be converted to 'StateT'.
-- It is only necessary in order to avoid overlapping instances.
newtype WarningStateT m a = WarningStateT
  { forall (m :: * -> *) a. WarningStateT m a -> StateT [String] m a
runWarningStateT :: StateT [String] m a
  -- ^ Interpret a 'MonadWarning' as a @StateT [String]@ monad,
  -- by accumulating warnings into the state.
  }
  deriving ((forall a b. (a -> b) -> WarningStateT m a -> WarningStateT m b)
-> (forall a b. a -> WarningStateT m b -> WarningStateT m a)
-> Functor (WarningStateT m)
forall a b. a -> WarningStateT m b -> WarningStateT m a
forall a b. (a -> b) -> WarningStateT m a -> WarningStateT m b
forall (m :: * -> *) a b.
Functor m =>
a -> WarningStateT m b -> WarningStateT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WarningStateT m a -> WarningStateT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WarningStateT m a -> WarningStateT m b
fmap :: forall a b. (a -> b) -> WarningStateT m a -> WarningStateT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WarningStateT m b -> WarningStateT m a
<$ :: forall a b. a -> WarningStateT m b -> WarningStateT m a
Functor, Functor (WarningStateT m)
Functor (WarningStateT m) =>
(forall a. a -> WarningStateT m a)
-> (forall a b.
    WarningStateT m (a -> b) -> WarningStateT m a -> WarningStateT m b)
-> (forall a b c.
    (a -> b -> c)
    -> WarningStateT m a -> WarningStateT m b -> WarningStateT m c)
-> (forall a b.
    WarningStateT m a -> WarningStateT m b -> WarningStateT m b)
-> (forall a b.
    WarningStateT m a -> WarningStateT m b -> WarningStateT m a)
-> Applicative (WarningStateT m)
forall a. a -> WarningStateT m a
forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m a
forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
forall a b.
WarningStateT m (a -> b) -> WarningStateT m a -> WarningStateT m b
forall a b c.
(a -> b -> c)
-> WarningStateT m a -> WarningStateT m b -> WarningStateT m c
forall (m :: * -> *). Monad m => Functor (WarningStateT m)
forall (m :: * -> *) a. Monad m => a -> WarningStateT m a
forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m a
forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
forall (m :: * -> *) a b.
Monad m =>
WarningStateT m (a -> b) -> WarningStateT m a -> WarningStateT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> WarningStateT m a -> WarningStateT m b -> WarningStateT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> WarningStateT m a
pure :: forall a. a -> WarningStateT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
WarningStateT m (a -> b) -> WarningStateT m a -> WarningStateT m b
<*> :: forall a b.
WarningStateT m (a -> b) -> WarningStateT m a -> WarningStateT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> WarningStateT m a -> WarningStateT m b -> WarningStateT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> WarningStateT m a -> WarningStateT m b -> WarningStateT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
*> :: forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m a
<* :: forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m a
Applicative, Applicative (WarningStateT m)
Applicative (WarningStateT m) =>
(forall a b.
 WarningStateT m a -> (a -> WarningStateT m b) -> WarningStateT m b)
-> (forall a b.
    WarningStateT m a -> WarningStateT m b -> WarningStateT m b)
-> (forall a. a -> WarningStateT m a)
-> Monad (WarningStateT m)
forall a. a -> WarningStateT m a
forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
forall a b.
WarningStateT m a -> (a -> WarningStateT m b) -> WarningStateT m b
forall (m :: * -> *). Monad m => Applicative (WarningStateT m)
forall (m :: * -> *) a. Monad m => a -> WarningStateT m a
forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> (a -> WarningStateT m b) -> WarningStateT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> (a -> WarningStateT m b) -> WarningStateT m b
>>= :: forall a b.
WarningStateT m a -> (a -> WarningStateT m b) -> WarningStateT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
>> :: forall a b.
WarningStateT m a -> WarningStateT m b -> WarningStateT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> WarningStateT m a
return :: forall a. a -> WarningStateT m a
Monad, MonadState [String])

-- | This instance adds the issue to the @[String]@ in the state.
instance Monad m => MonadWarning (WarningStateT m) where
  reportIssue :: String -> WarningStateT m ()
  reportIssue :: String -> WarningStateT m ()
reportIssue String
issue = ([String] -> ((), [String])) -> WarningStateT m ()
forall a. ([String] -> (a, [String])) -> WarningStateT m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\[String]
x -> ((), String
issue String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
x))

-- | Convert an 'Either' into a 'MonadWarning'. If 'Either' is 'Left'
-- it returns the default value (first parameter) and reports the 'String'
-- as an error. If 'Either' is 'Right' it just returns that value.
eitherToWarning :: MonadWarning m => a -> Either String a -> m a
eitherToWarning :: forall (m :: * -> *) a.
MonadWarning m =>
a -> Either String a -> m a
eitherToWarning a
def = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
issue -> do String -> m ()
forall (m :: * -> *). MonadWarning m => String -> m ()
reportIssue String
issue; a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def) a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return