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 :: forall a. String -> IO a
putStrLnErr String
err = do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"*ERROR* " forall a. [a] -> [a] -> [a]
++ String
err
        forall a. IO a
exitFailure

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

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

newtype DiagnosticsT m a = Diagnostics { forall (m :: * -> *) a.
DiagnosticsT m a -> MaybeT (WriterT [String] m) a
unDiagnostics :: MaybeT (WriterT [String] m) a }
  deriving stock (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
<$ :: forall a b. a -> DiagnosticsT m b -> DiagnosticsT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DiagnosticsT m b -> DiagnosticsT m a
fmap :: forall a b. (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 (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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> DiagnosticsT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
Applicative, 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 :: forall a. a -> DiagnosticsT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> DiagnosticsT m a
>> :: forall a b.
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
>>= :: forall a 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
Monad, 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 :: forall a. IO a -> DiagnosticsT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> DiagnosticsT m a
MonadIO, 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 :: forall e a.
Exception e =>
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
MonadCatch, 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 :: * -> *}. 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)
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
generalBracket :: forall a b c.
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 b.
((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 b.
((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
MonadMask, 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 :: forall e a. Exception e => e -> DiagnosticsT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> DiagnosticsT m a
MonadThrow)

runDiagnosticsT :: DiagnosticsT m a -> m (Maybe a, [String])
runDiagnosticsT :: forall (m :: * -> *) a. DiagnosticsT m a -> m (Maybe a, [String])
runDiagnosticsT (Diagnostics MaybeT (WriterT [String] m) a
m) = forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (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 = forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"*WARNING* " forall a. [a] -> [a] -> [a]
++ String
err]
    putStrLnInfo :: String -> DiagnosticsT m ()
putStrLnInfo String
err = forall (m :: * -> *) a.
MaybeT (WriterT [String] m) a -> DiagnosticsT m a
Diagnostics forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"*INFO* " forall a. [a] -> [a] -> [a]
++ String
err]

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

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