about summary refs log tree commit diff
path: root/users/Profpatsch/my-prelude/Data
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2023-05-28T18·58+0200
committerclbot <clbot@tvl.fyi>2023-07-13T23·03+0000
commit8c4730c433ba01cb17aab2917d495d055c4f468e (patch)
tree0817b780ac451b91109771876805e7c0c5a93404 /users/Profpatsch/my-prelude/Data
parentee21f725a38855e43fd8e82eb8c6c6fc99aca235 (diff)
chore(users/Profpatsch/*): more cabal maintenance r/6409
Change-Id: Ib1714abce2815873eb50dbeac088e812fa9098ab
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8686
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Diffstat (limited to 'users/Profpatsch/my-prelude/Data')
-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