module Data.Error.Tree where

import Data.String (IsString (..))
import Data.Tree qualified as Tree
import PossehlAnalyticsPrelude

-- | 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 {ErrorTree -> Tree Error
unErrorTree :: (Tree.Tree Error)}
  deriving stock (Int -> ErrorTree -> ShowS
[ErrorTree] -> ShowS
ErrorTree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorTree] -> ShowS
$cshowList :: [ErrorTree] -> ShowS
show :: ErrorTree -> String
$cshow :: ErrorTree -> String
showsPrec :: Int -> ErrorTree -> ShowS
$cshowsPrec :: Int -> ErrorTree -> ShowS
Show)

instance IsString ErrorTree where
  fromString :: String -> ErrorTree
fromString = Error -> ErrorTree
singleError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
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 :: Error -> ErrorTree
singleError Error
e = Tree Error -> ErrorTree
ErrorTree forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Tree.Node Error
e []

-- | Take a list of errors & create a new 'ErrorTree' with the given 'Error' as the root.
errorTree :: Error -> NonEmpty Error -> ErrorTree
errorTree :: Error -> NonEmpty Error -> ErrorTree
errorTree Error
topLevelErr NonEmpty Error
nestedErrs =
  Tree Error -> ErrorTree
ErrorTree
    ( forall a. a -> [Tree a] -> Tree a
Tree.Node
        Error
topLevelErr
        (NonEmpty Error
nestedErrs forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Error
e -> forall a. a -> [Tree a] -> Tree a
Tree.Node Error
e []) forall a b. a -> (a -> b) -> b
& forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList)
    )

-- | Attach more context to the root 'Error' of the 'ErrorTree', via 'errorContext'.
errorTreeContext :: Text -> ErrorTree -> ErrorTree
errorTreeContext :: Text -> ErrorTree -> ErrorTree
errorTreeContext Text
context (ErrorTree Tree Error
tree) =
  Tree Error -> ErrorTree
ErrorTree forall a b. (a -> b) -> a -> b
$
    Tree Error
tree
      { rootLabel :: Error
Tree.rootLabel = Tree Error
tree.rootLabel forall a b. a -> (a -> b) -> b
& Text -> Error -> Error
errorContext Text
context
      }

-- | Nest the given 'Error' around the ErrorTree
--
-- @
-- top level error
-- |
-- -- nestedError
--   |
--   -- error 1
--   |
--   -- error 2
-- @
nestedError ::
  Error -> -- top level
  ErrorTree -> -- nested
  ErrorTree
nestedError :: Error -> ErrorTree -> ErrorTree
nestedError Error
topLevelErr ErrorTree
nestedErr =
  Tree Error -> ErrorTree
ErrorTree forall a b. (a -> b) -> a -> b
$
    Tree.Node
      { rootLabel :: Error
Tree.rootLabel = Error
topLevelErr,
        subForest :: [Tree Error]
Tree.subForest = [ErrorTree
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 :: Error -> NonEmpty ErrorTree -> ErrorTree
nestedMultiError Error
topLevelErr NonEmpty ErrorTree
nestedErrs =
  Tree Error -> ErrorTree
ErrorTree forall a b. (a -> b) -> a -> b
$
    Tree.Node
      { rootLabel :: Error
Tree.rootLabel = Error
topLevelErr,
        subForest :: [Tree Error]
Tree.subForest = NonEmpty ErrorTree
nestedErrs forall a b. a -> (a -> b) -> b
& forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (.unErrorTree)
      }

prettyErrorTree :: ErrorTree -> Text
prettyErrorTree :: ErrorTree -> Text
prettyErrorTree (ErrorTree Tree Error
tree) =
  Tree Error
tree
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Error -> Text
prettyError
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> String
textToString
    forall a b. a -> (a -> b) -> b
& Tree String -> String
Tree.drawTree
    forall a b. a -> (a -> b) -> b
& String -> Text
stringToText

prettyErrorTrees :: NonEmpty ErrorTree -> Text
prettyErrorTrees :: NonEmpty ErrorTree -> Text
prettyErrorTrees NonEmpty ErrorTree
forest =
  NonEmpty ErrorTree
forest
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (.unErrorTree)
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Error -> Text
prettyError
    forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
textToString
    forall a b. a -> (a -> b) -> b
& forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList
    forall a b. a -> (a -> b) -> b
& [Tree String] -> String
Tree.drawForest
    forall a b. a -> (a -> b) -> b
& String -> Text
stringToText