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

    putStrLnErrs :: forall a. 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 a. NonEmpty a -> [a]
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 a. a -> WriterT [String] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing