module HaskellCI.Diagnostics where

import HaskellCI.Prelude

import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Writer      (WriterT, runWriterT, tell)
import System.Exit               (exitFailure)
import System.IO                 (hPutStrLn, stderr)

class Monad m => MonadDiagnostics m where
    putStrLnErr  :: String -> m a
    putStrLnErrs :: NonEmpty String -> m a
    putStrLnWarn :: String -> m ()
    putStrLnInfo :: String -> m ()

instance MonadDiagnostics IO where
    putStrLnErr :: String -> IO a
putStrLnErr String
err = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"*ERROR* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        IO a
forall a. IO a
exitFailure

    putStrLnErrs :: NonEmpty String -> IO a
putStrLnErrs NonEmpty String
errs = do
        NonEmpty String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty String
errs ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
err -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"*ERROR* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        IO a
forall a. IO a
exitFailure

    putStrLnWarn :: String -> IO ()
putStrLnWarn = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"*WARNING* " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    putStrLnInfo :: String -> IO ()
putStrLnInfo = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"*INFO* " String -> String -> String
forall a. [a] -> [a] -> [a]
++)

newtype DiagnosticsT m a = Diagnostics { DiagnosticsT m a -> MaybeT (WriterT [String] m) a
unDiagnostics :: MaybeT (WriterT [String] m) a }
  deriving stock (a -> DiagnosticsT m b -> DiagnosticsT m a
(a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
(forall a b. (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b)
-> (forall a b. a -> DiagnosticsT m b -> DiagnosticsT m a)
-> Functor (DiagnosticsT m)
forall a b. a -> DiagnosticsT m b -> DiagnosticsT m a
forall a b. (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
forall (m :: * -> *) a b.
Functor m =>
a -> DiagnosticsT m b -> DiagnosticsT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DiagnosticsT m b -> DiagnosticsT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DiagnosticsT m b -> DiagnosticsT m a
fmap :: (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
Functor)
  deriving newtype (Functor (DiagnosticsT m)
a -> DiagnosticsT m a
Functor (DiagnosticsT m)
-> (forall a. a -> DiagnosticsT m a)
-> (forall a b.
    DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b)
-> (forall a b c.
    (a -> b -> c)
    -> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m c)
-> (forall a b.
    DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b)
-> (forall a b.
    DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a)
-> Applicative (DiagnosticsT m)
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a
DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
(a -> b -> c)
-> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m c
forall a. a -> DiagnosticsT m a
forall a b.
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a
forall a b.
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
forall a b.
DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
forall a b c.
(a -> b -> c)
-> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m c
forall (m :: * -> *). Monad m => Functor (DiagnosticsT m)
forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a
forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT 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
<* :: DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m a
*> :: DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
liftA2 :: (a -> b -> c)
-> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m c
<*> :: DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m (a -> b) -> DiagnosticsT m a -> DiagnosticsT m b
pure :: a -> DiagnosticsT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (DiagnosticsT m)
Applicative, Applicative (DiagnosticsT m)
a -> DiagnosticsT m a
Applicative (DiagnosticsT m)
-> (forall a b.
    DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT m b)
-> (forall a b.
    DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b)
-> (forall a. a -> DiagnosticsT m a)
-> Monad (DiagnosticsT m)
DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT m b
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
forall a. a -> DiagnosticsT m a
forall a b.
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
forall a b.
DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT m b
forall (m :: * -> *). Monad m => Applicative (DiagnosticsT m)
forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT 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
return :: a -> DiagnosticsT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
>> :: DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> DiagnosticsT m b -> DiagnosticsT m b
>>= :: DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DiagnosticsT m a -> (a -> DiagnosticsT m b) -> DiagnosticsT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (DiagnosticsT m)
Monad, Monad (DiagnosticsT m)
Monad (DiagnosticsT m)
-> (forall a. IO a -> DiagnosticsT m a) -> MonadIO (DiagnosticsT m)
IO a -> DiagnosticsT m a
forall a. IO a -> DiagnosticsT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (DiagnosticsT m)
forall (m :: * -> *) a. MonadIO m => IO a -> DiagnosticsT m a
liftIO :: IO a -> DiagnosticsT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> DiagnosticsT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (DiagnosticsT m)
MonadIO, MonadThrow (DiagnosticsT m)
MonadThrow (DiagnosticsT m)
-> (forall e a.
    Exception e =>
    DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a)
-> MonadCatch (DiagnosticsT m)
DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a
forall e a.
Exception e =>
DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (DiagnosticsT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a
catch :: DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
DiagnosticsT m a -> (e -> DiagnosticsT m a) -> DiagnosticsT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (DiagnosticsT m)
MonadCatch, MonadCatch (DiagnosticsT m)
MonadCatch (DiagnosticsT m)
-> (forall b.
    ((forall a. DiagnosticsT m a -> DiagnosticsT m a)
     -> DiagnosticsT m b)
    -> DiagnosticsT m b)
-> (forall b.
    ((forall a. DiagnosticsT m a -> DiagnosticsT m a)
     -> DiagnosticsT m b)
    -> DiagnosticsT m b)
-> (forall a b c.
    DiagnosticsT m a
    -> (a -> ExitCase b -> DiagnosticsT m c)
    -> (a -> DiagnosticsT m b)
    -> DiagnosticsT m (b, c))
-> MonadMask (DiagnosticsT m)
DiagnosticsT m a
-> (a -> ExitCase b -> DiagnosticsT m c)
-> (a -> DiagnosticsT m b)
-> DiagnosticsT m (b, c)
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
forall b.
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
forall a b c.
DiagnosticsT m a
-> (a -> ExitCase b -> DiagnosticsT m c)
-> (a -> DiagnosticsT m b)
-> DiagnosticsT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (DiagnosticsT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
forall (m :: * -> *) a b c.
MonadMask m =>
DiagnosticsT m a
-> (a -> ExitCase b -> DiagnosticsT m c)
-> (a -> DiagnosticsT m b)
-> DiagnosticsT m (b, c)
generalBracket :: DiagnosticsT m a
-> (a -> ExitCase b -> DiagnosticsT m c)
-> (a -> DiagnosticsT m b)
-> DiagnosticsT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
DiagnosticsT m a
-> (a -> ExitCase b -> DiagnosticsT m c)
-> (a -> DiagnosticsT m b)
-> DiagnosticsT m (b, c)
uninterruptibleMask :: ((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
mask :: ((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. DiagnosticsT m a -> DiagnosticsT m a)
 -> DiagnosticsT m b)
-> DiagnosticsT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (DiagnosticsT m)
MonadMask, Monad (DiagnosticsT m)
e -> DiagnosticsT m a
Monad (DiagnosticsT m)
-> (forall e a. Exception e => e -> DiagnosticsT m a)
-> MonadThrow (DiagnosticsT m)
forall e a. Exception e => e -> DiagnosticsT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (DiagnosticsT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> DiagnosticsT m a
throwM :: e -> DiagnosticsT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> DiagnosticsT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (DiagnosticsT m)
MonadThrow)

runDiagnosticsT :: DiagnosticsT m a -> m (Maybe a, [String])
runDiagnosticsT :: DiagnosticsT m a -> m (Maybe a, [String])
runDiagnosticsT (Diagnostics MaybeT (WriterT [String] m) a
m) = WriterT [String] m (Maybe a) -> m (Maybe a, [String])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (MaybeT (WriterT [String] m) a -> WriterT [String] m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (WriterT [String] m) a
m)

instance Monad m => MonadDiagnostics (DiagnosticsT m) where
    putStrLnWarn :: String -> DiagnosticsT m ()
putStrLnWarn String
err = MaybeT (WriterT [String] m) () -> DiagnosticsT m ()
forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics (MaybeT (WriterT [String] m) () -> DiagnosticsT m ())
-> MaybeT (WriterT [String] m) () -> DiagnosticsT m ()
forall a b. (a -> b) -> a -> b
$ [String] -> MaybeT (WriterT [String] m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"*WARNING* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err]
    putStrLnInfo :: String -> DiagnosticsT m ()
putStrLnInfo String
err = MaybeT (WriterT [String] m) () -> DiagnosticsT m ()
forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics (MaybeT (WriterT [String] m) () -> DiagnosticsT m ())
-> MaybeT (WriterT [String] m) () -> DiagnosticsT m ()
forall a b. (a -> b) -> a -> b
$ [String] -> MaybeT (WriterT [String] m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"*INFO* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err]

    putStrLnErr :: String -> DiagnosticsT m a
putStrLnErr String
err = MaybeT (WriterT [String] m) a -> DiagnosticsT m a
forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics (MaybeT (WriterT [String] m) a -> DiagnosticsT m a)
-> MaybeT (WriterT [String] m) a -> DiagnosticsT m a
forall a b. (a -> b) -> a -> b
$ do
        [String] -> MaybeT (WriterT [String] m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"*ERROR* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err]
        WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a)
-> WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a
forall a b. (a -> b) -> a -> b
$ Maybe a -> WriterT [String] m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

    putStrLnErrs :: NonEmpty String -> DiagnosticsT m a
putStrLnErrs NonEmpty String
errs = MaybeT (WriterT [String] m) a -> DiagnosticsT m a
forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics (MaybeT (WriterT [String] m) a -> DiagnosticsT m a)
-> MaybeT (WriterT [String] m) a -> DiagnosticsT m a
forall a b. (a -> b) -> a -> b
$ do
        [String] -> MaybeT (WriterT [String] m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([String] -> MaybeT (WriterT [String] m) ())
-> [String] -> MaybeT (WriterT [String] m) ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"*ERROR* " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (NonEmpty String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty String
errs)
        WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a)
-> WriterT [String] m (Maybe a) -> MaybeT (WriterT [String] m) a
forall a b. (a -> b) -> a -> b
$ Maybe a -> WriterT [String] m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing