{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- | A version of 'GraphulaT' that logs the generated graph
module Graphula.Logged
  ( GraphulaLoggedT
  , runGraphulaLoggedT
  , runGraphulaLoggedWithFileT
  , runGraphulaLoggedUsingT
  ) where

import Prelude

import Control.Monad.IO.Unlift
import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Foldable (traverse_)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Sequence (Seq, empty, (|>))
import Data.Text (Text, pack)
import qualified Data.Text.IO as T
import Graphula.Class
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory)
import System.IO (Handle, IOMode(..), hClose, openFile)
import System.IO.Temp (openTempFile)
import Test.HUnit.Lang
  (FailureReason(..), HUnitFailure(..), formatFailureReason)
import UnliftIO.Exception (bracket, catch, throwIO)

newtype GraphulaLoggedT m a = GraphulaLoggedT
  { GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
runGraphulaLoggedT' :: ReaderT (IORef (Seq Text)) m a
  }
  deriving newtype
    ( a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
(forall a b.
 (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b)
-> (forall a b. a -> GraphulaLoggedT m b -> GraphulaLoggedT m a)
-> Functor (GraphulaLoggedT m)
forall a b. a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall a b. (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
fmap :: (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
Functor
    , Functor (GraphulaLoggedT m)
a -> GraphulaLoggedT m a
Functor (GraphulaLoggedT m)
-> (forall a. a -> GraphulaLoggedT m a)
-> (forall a b.
    GraphulaLoggedT m (a -> b)
    -> GraphulaLoggedT m a -> GraphulaLoggedT m b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphulaLoggedT m a
    -> GraphulaLoggedT m b
    -> GraphulaLoggedT m c)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a)
-> Applicative (GraphulaLoggedT m)
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
forall a. a -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a b.
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall a b c.
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
forall (f :: Type -> Type).
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 :: Type -> Type).
Applicative m =>
Functor (GraphulaLoggedT m)
forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
<* :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
$c<* :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
*> :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
$c*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
liftA2 :: (a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
<*> :: GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
$c<*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
pure :: a -> GraphulaLoggedT m a
$cpure :: forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaLoggedT m a
$cp1Applicative :: forall (m :: Type -> Type).
Applicative m =>
Functor (GraphulaLoggedT m)
Applicative
    , Applicative (GraphulaLoggedT m)
a -> GraphulaLoggedT m a
Applicative (GraphulaLoggedT m)
-> (forall a b.
    GraphulaLoggedT m a
    -> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b)
-> (forall a. a -> GraphulaLoggedT m a)
-> Monad (GraphulaLoggedT m)
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a. a -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a b.
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaLoggedT m)
forall (m :: Type -> Type) a. Monad m => a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
forall (m :: Type -> Type).
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 -> GraphulaLoggedT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> GraphulaLoggedT m a
>> :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
>>= :: GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
$cp1Monad :: forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaLoggedT m)
Monad
    , Monad (GraphulaLoggedT m)
Monad (GraphulaLoggedT m)
-> (forall a. IO a -> GraphulaLoggedT m a)
-> MonadIO (GraphulaLoggedT m)
IO a -> GraphulaLoggedT m a
forall a. IO a -> GraphulaLoggedT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (GraphulaLoggedT m)
forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaLoggedT m a
liftIO :: IO a -> GraphulaLoggedT m a
$cliftIO :: forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaLoggedT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (GraphulaLoggedT m)
MonadIO
    , MonadReader (IORef (Seq Text))
    )

instance MonadTrans GraphulaLoggedT where
  lift :: m a -> GraphulaLoggedT m a
lift = ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a.
ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a
GraphulaLoggedT (ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a)
-> (m a -> ReaderT (IORef (Seq Text)) m a)
-> m a
-> GraphulaLoggedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (IORef (Seq Text)) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadGraphulaBackend m, MonadIO m) => MonadGraphulaBackend (GraphulaLoggedT m) where
  type Logging (GraphulaLoggedT m) = Show
  askGen :: GraphulaLoggedT m (IORef QCGen)
askGen = m (IORef QCGen) -> GraphulaLoggedT m (IORef QCGen)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (IORef QCGen)
forall (m :: Type -> Type).
MonadGraphulaBackend m =>
m (IORef QCGen)
askGen
  logNode :: a -> GraphulaLoggedT m ()
logNode a
n = do
    IORef (Seq Text)
graphLog <- GraphulaLoggedT m (IORef (Seq Text))
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    IO () -> GraphulaLoggedT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GraphulaLoggedT m ()) -> IO () -> GraphulaLoggedT m ()
forall a b. (a -> b) -> a -> b
$ IORef (Seq Text) -> (Seq Text -> Seq Text) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Seq Text)
graphLog (Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
|> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
n))

instance (Monad m, MonadGraphulaFrontend m) => MonadGraphulaFrontend (GraphulaLoggedT m) where
  insert :: Maybe (Key a) -> a -> GraphulaLoggedT m (Maybe (Entity a))
insert Maybe (Key a)
mKey = m (Maybe (Entity a)) -> GraphulaLoggedT m (Maybe (Entity a))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Entity a)) -> GraphulaLoggedT m (Maybe (Entity a)))
-> (a -> m (Maybe (Entity a)))
-> a
-> GraphulaLoggedT m (Maybe (Entity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Key a) -> a -> m (Maybe (Entity a))
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
insert Maybe (Key a)
mKey
  remove :: Key a -> GraphulaLoggedT m ()
remove = m () -> GraphulaLoggedT m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GraphulaLoggedT m ())
-> (Key a -> m ()) -> Key a -> GraphulaLoggedT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> m ()
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Key a -> m ()
remove

-- | Run the graph while logging to a temporary file
runGraphulaLoggedT :: MonadUnliftIO m => GraphulaLoggedT m a -> m a
runGraphulaLoggedT :: GraphulaLoggedT m a -> m a
runGraphulaLoggedT = (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
forall (m :: Type -> Type) a.
MonadUnliftIO m =>
(IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp

-- | 'runGraphulaLoggedT', but to the specified file
runGraphulaLoggedWithFileT
  :: MonadUnliftIO m => FilePath -> GraphulaLoggedT m a -> m a
runGraphulaLoggedWithFileT :: String -> GraphulaLoggedT m a -> m a
runGraphulaLoggedWithFileT = (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
forall (m :: Type -> Type) a.
MonadUnliftIO m =>
(IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT ((IORef (Seq Text) -> HUnitFailure -> m a)
 -> GraphulaLoggedT m a -> m a)
-> (String -> IORef (Seq Text) -> HUnitFailure -> m a)
-> String
-> GraphulaLoggedT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile

-- | 'runGraphulaLoggedT', but using the custom action to accumulate
runGraphulaLoggedUsingT
  :: MonadUnliftIO m
  => (IORef (Seq Text) -> HUnitFailure -> m a)
  -> GraphulaLoggedT m a
  -> m a
runGraphulaLoggedUsingT :: (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT IORef (Seq Text) -> HUnitFailure -> m a
logFail GraphulaLoggedT m a
action = do
  IORef (Seq Text)
graphLog <- IO (IORef (Seq Text)) -> m (IORef (Seq Text))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Text)) -> m (IORef (Seq Text)))
-> IO (IORef (Seq Text)) -> m (IORef (Seq Text))
forall a b. (a -> b) -> a -> b
$ Seq Text -> IO (IORef (Seq Text))
forall a. a -> IO (IORef a)
newIORef Seq Text
forall a. Seq a
empty
  ReaderT (IORef (Seq Text)) m a -> IORef (Seq Text) -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
forall (m :: Type -> Type) a.
GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
runGraphulaLoggedT' GraphulaLoggedT m a
action) IORef (Seq Text)
graphLog m a -> (HUnitFailure -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IORef (Seq Text) -> HUnitFailure -> m a
logFail IORef (Seq Text)
graphLog

logFailUsing
  :: MonadIO m
  => IO (FilePath, Handle)
  -> IORef (Seq Text)
  -> HUnitFailure
  -> m a
logFailUsing :: IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing IO (String, Handle)
f IORef (Seq Text)
graphLog HUnitFailure
hunitfailure =
  (String -> HUnitFailure -> m a) -> HUnitFailure -> String -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> HUnitFailure -> m a
rethrowHUnitLogged HUnitFailure
hunitfailure (String -> m a) -> m String -> m a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Seq Text) -> IO (String, Handle) -> m String
forall (m :: Type -> Type).
MonadIO m =>
IORef (Seq Text) -> IO (String, Handle) -> m String
logGraphToHandle IORef (Seq Text)
graphLog IO (String, Handle)
f

logFailFile :: MonadIO m => FilePath -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile :: String -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile String
path = IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing ((String
path, ) (Handle -> (String, Handle)) -> IO Handle -> IO (String, Handle)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode)

logFailTemp :: MonadIO m => IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp :: IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp = IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing (IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a)
-> IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall a b. (a -> b) -> a -> b
$ do
  String
tmp <- (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/graphula") (String -> String) -> IO String -> IO String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
tmp
  String -> String -> IO (String, Handle)
openTempFile String
tmp String
"fail-.graphula"

logGraphToHandle
  :: (MonadIO m) => IORef (Seq Text) -> IO (FilePath, Handle) -> m FilePath
logGraphToHandle :: IORef (Seq Text) -> IO (String, Handle) -> m String
logGraphToHandle IORef (Seq Text)
graphLog IO (String, Handle)
openHandle = IO String -> m String
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO String)
-> IO String
forall (m :: Type -> Type) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
  IO (String, Handle)
openHandle
  (Handle -> IO ()
hClose (Handle -> IO ())
-> ((String, Handle) -> Handle) -> (String, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Handle) -> Handle
forall a b. (a, b) -> b
snd)
  (\(String
path, Handle
handle) -> do
    Seq Text
nodes <- IORef (Seq Text) -> IO (Seq Text)
forall a. IORef a -> IO a
readIORef IORef (Seq Text)
graphLog
    String
path String -> IO () -> IO String
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ (Text -> IO ()) -> Seq Text -> IO ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> Text -> IO ()
T.hPutStrLn Handle
handle) Seq Text
nodes
  )

rethrowHUnitLogged :: MonadIO m => FilePath -> HUnitFailure -> m a
rethrowHUnitLogged :: String -> HUnitFailure -> m a
rethrowHUnitLogged String
path =
  String -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> HUnitFailure -> m a
rethrowHUnitWith (String
"Graph dumped in temp file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)

rethrowHUnitWith :: MonadIO m => String -> HUnitFailure -> m a
rethrowHUnitWith :: String -> HUnitFailure -> m a
rethrowHUnitWith String
message (HUnitFailure Maybe SrcLoc
l FailureReason
r) =
  HUnitFailure -> m a
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
throwIO (HUnitFailure -> m a) -> (String -> HUnitFailure) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
l (FailureReason -> HUnitFailure)
-> (String -> FailureReason) -> String -> HUnitFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FailureReason
Reason (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FailureReason -> String
formatFailureReason FailureReason
r