From 26abe64d9dbcc84c9c33754e96704461f23aebd3 Mon Sep 17 00:00:00 2001
From: 0rphee <0rph3e@proton.me>
Date: Fri, 22 Dec 2023 14:00:53 -0600
Subject: [PATCH] Add pretty printing without colour

---
 trial/src/Trial.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)

diff --git a/trial/src/Trial.hs b/trial/src/Trial.hs
index c0ad09a..e4f735a 100644
--- a/trial/src/Trial.hs
+++ b/trial/src/Trial.hs
@@ -90,6 +90,13 @@ module Trial
        , prettyTaggedTrial
        , prettyTaggedTrialWith
 
+         -- * Pretty printing without colour
+       , prettyFatalityNoColour
+       , prettyTrialNoColour
+       , prettyTrialWithNoColour
+       , prettyTaggedTrialNoColour
+       , prettyTaggedTrialWithNoColour
+
          -- * Configuration helpers
          -- $phase
        , Phase (..)
@@ -840,6 +847,71 @@ prettyTaggedTrialWith showRes = \case
         <> C.i "\nWith the following warnings:\n"
         <> foldr (\e -> (<>) (prettyEntry (W, e))) "" es
 
+{- | Print aligned 'Fatality'.
+
+-}
+prettyFatalityNoColour :: (Semigroup str, IsString str) => Fatality -> str
+prettyFatalityNoColour = \case
+    E -> "Error  "
+    W -> "Warning"
+
+prettyEntryNoColour :: (Semigroup e, IsString e) => (Fatality, e) -> e
+prettyEntryNoColour (f, e) = "  * [" <> prettyFatalityNoColour f <> "] " <> e <> "\n"
+
+{- | Pretty-printing of 'Trial'.
+
+-}
+prettyTrialNoColour
+    :: (Show a, Semigroup e, IsString e)
+    => Trial e a
+    -> e
+prettyTrialNoColour = prettyTrialWithNoColour show
+
+{- | Similar to 'prettyTrialNoColour', but accepts a function to show Result in the
+provided way.
+
+-}
+prettyTrialWithNoColour
+    :: (Semigroup e, IsString e)
+    => (a -> String)
+    -> Trial e a
+    -> e
+prettyTrialWithNoColour showRes = \case
+    Fiasco es -> "Fiasco:\n"
+        <> foldr (\e -> (<>) (prettyEntryNoColour e)) "" es
+    Result es a -> "Result:\n"
+        <> fromString (unlines $ map ("  " <>) $ lines $ showRes a)
+        <> "\nWith the following warnings:\n"
+        <> foldr (\e -> (<>) (prettyEntryNoColour (W, e))) "" es
+
+{- | Pretty-printing of 'TaggedTrial'. Similar to
+'prettyTrialNoColour', but also prints the resulting @tag@ for 'Result'.
+
+-}
+prettyTaggedTrialNoColour
+    :: (Show a, Semigroup e, IsString e)
+    => TaggedTrial e a
+    -> e
+prettyTaggedTrialNoColour = prettyTaggedTrialWithNoColour show
+
+{- | Similar to 'prettyTaggedTrialNoColour', but accepts a function to show the 'Result'
+in the provided way.
+
+--}
+prettyTaggedTrialWithNoColour
+    :: (Semigroup e, IsString e)
+    => (a -> String)
+    -> TaggedTrial e a
+    -> e
+prettyTaggedTrialWithNoColour showRes = \case
+    Fiasco es -> "Fiasco:\n"
+        <> foldr (\e -> (<>) (prettyEntryNoColour e)) "" es
+    Result es (tag, a) -> "Result:\n"
+        <> ("  [" <> tag <> "]\n    ")
+        <> fromString (unlines $ map ("  " <>) $ lines $ showRes a)
+        <> "\nWith the following warnings:\n"
+        <> foldr (\e -> (<>) (prettyEntryNoColour (W, e))) "" es
+
 ----------------------------------------------------------------------------
 -- Configurations
 ----------------------------------------------------------------------------