about summary refs log tree commit diff
path: root/users/Profpatsch/my-prelude/Data/Error/Tree.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/Profpatsch/my-prelude/Data/Error/Tree.hs')
-rw-r--r--users/Profpatsch/my-prelude/Data/Error/Tree.hs113
1 files changed, 0 insertions, 113 deletions
diff --git a/users/Profpatsch/my-prelude/Data/Error/Tree.hs b/users/Profpatsch/my-prelude/Data/Error/Tree.hs
deleted file mode 100644
index e8e45e704882..000000000000
--- a/users/Profpatsch/my-prelude/Data/Error/Tree.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GHC2021 #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-
-module Data.Error.Tree where
-
-import Data.String (IsString (..))
-import Data.Tree qualified as Tree
-import MyPrelude
-
--- | A tree of 'Error's, with a single root 'Error' and 0..n nested 'ErrorTree's.
---
--- @@
--- top error
--- |
--- |-- error 1
--- | |
--- |  -- error 1.1
--- |
--- |-- error 2
--- @@
-newtype ErrorTree = ErrorTree {unErrorTree :: (Tree.Tree Error)}
-  deriving stock (Show)
-
-instance IsString ErrorTree where
-  fromString = singleError . fromString
-
--- deriving newtype (Ord) -- TODO: Add this instance with containers-0.6.5
-
--- | Turn a single 'Error' into an 'ErrorTree', a leaf.
-singleError :: Error -> ErrorTree
-singleError e = ErrorTree $ Tree.Node e []
-
--- | Take a list of errors & create a new 'ErrorTree' with the given 'Error' as the root.
-errorTree :: Error -> NonEmpty Error -> ErrorTree
-errorTree topLevelErr nestedErrs =
-  ErrorTree
-    ( Tree.Node
-        topLevelErr
-        (nestedErrs <&> (\e -> Tree.Node e []) & toList)
-    )
-
--- | Attach more context to the root 'Error' of the 'ErrorTree', via 'errorContext'.
-errorTreeContext :: Text -> ErrorTree -> ErrorTree
-errorTreeContext context (ErrorTree tree) =
-  ErrorTree $
-    tree
-      { Tree.rootLabel = tree.rootLabel & errorContext context
-      }
-
--- | Nest the given 'Error' around the ErrorTree
---
--- @@
--- top level error
--- |
--- -- nestedError
---   |
---   -- error 1
---   |
---   -- error 2
--- @@
-nestedError ::
-  Error -> -- top level
-  ErrorTree -> -- nested
-  ErrorTree
-nestedError topLevelErr nestedErr =
-  ErrorTree $
-    Tree.Node
-      { Tree.rootLabel = topLevelErr,
-        Tree.subForest = [nestedErr.unErrorTree]
-      }
-
--- | Nest the given 'Error' around the list of 'ErrorTree's.
---
--- @@
--- top level error
--- |
--- |- nestedError1
--- | |
--- | -- error 1
--- | |
--- | -- error 2
--- |
--- |- nestedError 2
--- @@
-nestedMultiError ::
-  Error -> -- top level
-  NonEmpty ErrorTree -> -- nested
-  ErrorTree
-nestedMultiError topLevelErr nestedErrs =
-  ErrorTree $
-    Tree.Node
-      { Tree.rootLabel = topLevelErr,
-        Tree.subForest = nestedErrs & toList <&> (.unErrorTree)
-      }
-
-prettyErrorTree :: ErrorTree -> Text
-prettyErrorTree (ErrorTree tree) =
-  tree
-    <&> prettyError
-    <&> textToString
-    & Tree.drawTree
-    & stringToText
-
-prettyErrorTrees :: NonEmpty ErrorTree -> Text
-prettyErrorTrees forest =
-  forest
-    <&> (.unErrorTree)
-    <&> fmap prettyError
-    <&> fmap textToString
-    & toList
-    & Tree.drawForest
-    & stringToText