packages feed

pa-error-tree 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+46/−1 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.Error.Tree: restrictErrorTree :: (HasField "maxlength" dat Natural, HasField "maxdepth" dat Natural) => dat -> ErrorTree -> ErrorTree

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pa-error-tree +## 0.1.1.0 -- 2024-09-04++- Add `restrictErrorTree`+ ## 0.1.0.0 -- 2023-05-19  - First release
pa-error-tree.cabal view
@@ -1,7 +1,7 @@ cabal-version:      3.0 -- !!! ATTN: file autogenerated from pa-template.cabal.mustache on toplevel !!! name:               pa-error-tree-version:            0.1.0.0+version:            0.1.1.0 synopsis:           Collect a tree of errors and pretty-print description:         license:            BSD-3-Clause@@ -60,6 +60,10 @@      -- to enable the `type` keyword in import lists (ormolu uses this automatically)     ExplicitNamespaces++    -- allows defining pattern synonyms, but also the `import Foo (pattern FooPattern)` import syntax+    PatternSynonyms+    default-language: GHC2021 
src/Data/Error/Tree.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE QuasiQuotes #-}+ module Data.Error.Tree where +import Data.List qualified as List+import Data.Sequence qualified as Seq import Data.String (IsString (..)) import Data.Tree qualified as Tree import PossehlAnalyticsPrelude@@ -107,3 +111,36 @@     & toList     & Tree.drawForest     & stringToText++-- | Sometimes, ErrorTrees can get very large.+-- In that case, it’s recommended to first think about whether you can e.g. chunk the validation logic.+--+-- But even so, restricting the size of the `ErrorTree` before printing it is often a good idea.+--+-- This will make sure the given `maxlength` and `maxdepth` are not exceeded, and insert warnings if some subtree was elided.+restrictErrorTree ::+  ( HasField "maxlength" dat Natural,+    HasField "maxdepth" dat Natural+  ) =>+  dat ->+  ErrorTree ->+  ErrorTree+restrictErrorTree dat (ErrorTree t) = ErrorTree $ go 0 t+  where+    go :: Natural -> Tree.Tree Error -> Tree.Tree Error+    go curDepth (Tree.Node a children) = do+      let maxlengthInt = dat.maxlength & fromIntegral @Natural @Int+      let childplusone = children & List.take (maxlengthInt + 1) & Seq.fromList+      if curDepth == dat.maxdepth+        then Tree.Node a [Tree.Node [fmt|<More errors, max depth reached ({dat.maxdepth})>|] []]+        else+          Tree.Node a $+            map (go (curDepth + 1)) $+              toList $+                if List.length childplusone > maxlengthInt+                  then+                    ( ( Seq.take maxlengthInt childplusone+                          Seq.:|> (Tree.Node [fmt|<More errors, max length reached ({dat.maxlength})>|] [])+                      )+                    )+                  else childplusone