about summary refs log tree commit diff
path: root/users
diff options
context:
space:
mode:
Diffstat (limited to 'users')
-rw-r--r--users/Profpatsch/mailbox-org/MailboxOrg.hs201
-rw-r--r--users/Profpatsch/mailbox-org/default.nix2
-rw-r--r--users/Profpatsch/mailbox-org/mailbox-org.cabal5
-rw-r--r--users/Profpatsch/my-prelude/Aeson.hs188
-rw-r--r--users/Profpatsch/my-prelude/Data/Error/Tree.hs113
-rw-r--r--users/Profpatsch/my-prelude/default.nix8
-rw-r--r--users/Profpatsch/my-prelude/my-prelude.cabal7
7 files changed, 484 insertions, 40 deletions
diff --git a/users/Profpatsch/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs
index a7eab3305f6a..80222dbb0dc1 100644
--- a/users/Profpatsch/mailbox-org/MailboxOrg.hs
+++ b/users/Profpatsch/mailbox-org/MailboxOrg.hs
@@ -1,56 +1,187 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module Main where
 
+import Aeson (parseErrorTree)
 import Control.Monad (replicateM)
+import Data.Aeson qualified as Json
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.KeyMap qualified as KeyMap
 import Data.ByteString qualified as ByteString
+import Data.ByteString.Char8 qualified as Char8
+import Data.Error.Tree (prettyErrorTree)
 import Data.List qualified as List
+import Data.Map qualified as Map
+import ExecHelpers
+import GHC.Records (HasField (..))
+import Label
 import MyPrelude
 import Network.HTTP.Conduit qualified as Client
 import Network.HTTP.Simple qualified as Client
 import Pretty
 import System.Exit qualified as Exit
+import System.Process qualified as Proc
 import System.Random qualified as Random
 import System.Random.Stateful qualified as Random
 import Prelude hiding (log)
-import Data.Aeson (Value)
-import Label
-import qualified System.Process as Proc
-import qualified Data.ByteString.Char8 as Char8
 
 secret :: IO (T2 "email" ByteString "password" ByteString)
 secret = do
   T2
     (label @"email" "mail@profpatsch.de")
-    <$> (label @"password" <$> fromPass "email/mailbox.org" )
+    <$> (label @"password" <$> fromPass "email/mailbox.org")
   where
-    fromPass name = Proc.readProcess "pass" [name] ""
-     <&> stringToText <&> textToBytesUtf8
-      <&> Char8.strip
+    fromPass name =
+      Proc.readProcess "pass" [name] ""
+        <&> stringToText
+        <&> textToBytesUtf8
+        <&> Char8.strip
+
+progName :: Text
+progName = "mailbox-org"
+
+log :: Error -> IO ()
+log err = do
+  putStderrLn (errorContext progName err & prettyError)
 
 main :: IO ()
-main = run =<< secret
-
-
-run :: (HasField "email" dat ByteString,
-  HasField "password" dat ByteString) =>
- dat -> IO ()
-run dat = do
-  session <- login dat
-  req <- Client.parseRequest "https://office.mailbox.org/appsuite/api/mailfilter/v2?action=list&columns=1"
-    <&> Client.setRequestMethod "PUT"
-    <&> addSession session
-  Client.httpJSON @_ @Value req
-    >>= okOrDie
-    <&> Client.responseBody
-    >>= printPretty
+main = run (CurrentProgramName progName) =<< secret
+
+data MailfilterList = MailfilterList
+  { id_ :: Json.Value,
+    rulename :: Text
+  }
+  deriving stock (Show, Eq)
+
+run ::
+  ( HasField "email" dat ByteString,
+    HasField "password" dat ByteString
+  ) =>
+  CurrentProgramName ->
+  dat ->
+  IO ()
+run currentProg loginData = do
+  session <- login loginData
+  filters <-
+    mailfilter
+      session
+      "list"
+      ( Json.key "data" $ do
+          ( Json.eachInArray $ asDat @"mailfilter" $ do
+              id_ <- Json.key "id" Json.asValue
+              rulename <- Json.key "rulename" Json.asText
+              pure MailfilterList {..}
+            )
+            <&> mapFromListOn (\dat -> getLabel @"id_" dat.parsed)
+      )
+      ([] :: [()])
+  filters
+    & Map.elems
+    & traverse_
+      ( updateIfDifferent
+          session
+          ( \el ->
+              pure $
+                el.original.mailfilter
+                  & KeyMap.insert "active" (Json.Bool False)
+          )
+          (pure ())
+      )
+  where
+    mapFromListOn :: Ord k => (a -> k) -> [a] -> Map k a
+    mapFromListOn on xs = xs <&> (\x -> (on x, x)) & Map.fromList
+    updateIfDifferent ::
+      forall label parsed.
+      ( HasField "id_" parsed Json.Value,
+        HasField "rulename" parsed Text
+      ) =>
+      Session ->
+      (Dat label Json.Object parsed -> IO Json.Object) ->
+      Json.Parse Error () ->
+      Dat label Json.Object parsed ->
+      IO ()
+    updateIfDifferent session switcheroo parser dat = do
+      new <- switcheroo dat
+      if new /= getField @label dat.original
+        then do
+          log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|]
+          mailfilter session "update" parser new
+        else do
+          log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|]
+
+    prettyRequestShort :: Client.Request -> Text
+    prettyRequestShort req = [fmt|request {req & Client.method}: {req & Client.host}{req & Client.path}{req & Client.queryString}|]
+
+    -- https://oxpedia.org/wiki/index.php?title=HTTP_API_MailFilter
+    mailfilter session action parser body = do
+      req <-
+        Client.parseRequest "https://office.mailbox.org/appsuite/api/mailfilter/v2"
+          <&> Client.setQueryString
+            [ ("action", Just action),
+              ("colums", Just "1")
+            ]
+          <&> Client.setRequestMethod "PUT"
+          <&> Client.setRequestBodyJSON body
+          <&> addSession session
+      req
+        & httpJSON currentProg [fmt|Cannot parse result for {req & prettyRequestShort}|] parser
+        >>= okOrDie
+        >>= (\resp -> printPretty resp >> pure resp)
+        <&> Client.responseBody
 
 newtype Session = Session Client.CookieJar
 
+httpJSON ::
+  CurrentProgramName ->
+  Error ->
+  Json.Parse Error b ->
+  Client.Request ->
+  IO (Client.Response b)
+httpJSON currentProg errMsg parser req = do
+  req
+    & Client.httpJSON @_ @Json.Value
+    >>= traverse
+      ( \val -> do
+          case val of
+            Json.Object obj
+              | "error" `KeyMap.member` obj
+                  && "error_desc" `KeyMap.member` obj -> do
+                  printPretty obj
+                  diePanic currentProg "Server returned above inline error"
+            _ -> pure ()
+          val & Json.parseValue parser & \case
+            Left errs ->
+              errs
+                & parseErrorTree errMsg
+                & prettyErrorTree
+                & diePanic currentProg
+            Right a -> pure a
+      )
+
+data Dat label orig parsed = Dat
+  { original :: Label label orig,
+    parsed :: parsed
+  }
+  deriving stock (Show, Eq)
+
+asDat ::
+  forall label err m a.
+  Monad m =>
+  Json.ParseT err m a ->
+  Json.ParseT err m (Dat label Json.Object a)
+asDat parser = do
+  original <- label @label <$> Json.asObject
+  parsed <- parser
+  pure Dat {..}
+
 addSession :: Session -> Client.Request -> Client.Request
 addSession (Session jar) req = do
   let sessionId =
@@ -60,16 +191,12 @@ addSession (Session jar) req = do
           & annotate "The cookie jar did not contain an open-exchange-session-*"
           & unwrapError
           & (.cookie_value)
-  (req
-    & Client.addToRequestQueryString [("session", Just sessionId)])
-      { Client.cookieJar = Just jar }
+
+  let req' = req & Client.addToRequestQueryString [("session", Just sessionId)]
+  req' {Client.cookieJar = Just jar}
 
 -- | Log into the mailbox.org service, and return the session secret cookies.
-login ::
-  (HasField "email" dat ByteString,
-  HasField "password" dat ByteString) =>
-  dat ->
-  IO Session
+login :: (HasField "email" dat ByteString, HasField "password" dat ByteString) => dat -> IO Session
 login dat = do
   rnd <- randomString
   req <-
@@ -91,7 +218,6 @@ login dat = do
     <&> Client.responseCookieJar
     <&> Session
   where
-
     -- For some reason they want the client to pass a random string
     -- which is used for the session?‽!?
     randomString = do
@@ -102,11 +228,10 @@ login dat = do
         & replicateM len
         <&> map (\index -> chars !! index)
 
-
 okOrDie :: Show a => Client.Response a -> IO (Client.Response a)
 okOrDie resp =
-      case resp & Client.getResponseStatusCode of
-        200 -> pure resp
-        _ -> do
-          printPretty resp
-          Exit.die "non-200 result"
+  case resp & Client.getResponseStatusCode of
+    200 -> pure resp
+    _ -> do
+      printPretty resp
+      Exit.die "non-200 result"
diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix
index b9b0c0f5f41d..bb8082bd4c80 100644
--- a/users/Profpatsch/mailbox-org/default.nix
+++ b/users/Profpatsch/mailbox-org/default.nix
@@ -5,8 +5,10 @@ let
     {
       libraries = [
         depot.users.Profpatsch.my-prelude
+        depot.users.Profpatsch.execline.exec-helpers-hs
         pkgs.haskellPackages.aeson
         pkgs.haskellPackages.http-conduit
+        pkgs.haskellPackages.aeson-better-errors
 
       ];
       ghcArgs = [ "-threaded" ];
diff --git a/users/Profpatsch/mailbox-org/mailbox-org.cabal b/users/Profpatsch/mailbox-org/mailbox-org.cabal
index eab66242d4db..3a1ed917303d 100644
--- a/users/Profpatsch/mailbox-org/mailbox-org.cabal
+++ b/users/Profpatsch/mailbox-org/mailbox-org.cabal
@@ -10,11 +10,14 @@ executable mailbox-org
     build-depends:
         base >=4.15 && <5,
         my-prelude,
+        exec-helpers,
         random,
         http-conduit,
         http-client,
         aeson,
+        aeson-better-errors,
         bytestring,
-        process
+        process,
+        containers,
 
     default-language: Haskell2010
diff --git a/users/Profpatsch/my-prelude/Aeson.hs b/users/Profpatsch/my-prelude/Aeson.hs
new file mode 100644
index 000000000000..ad095e1b43a7
--- /dev/null
+++ b/users/Profpatsch/my-prelude/Aeson.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Aeson where
+
+import Data.Aeson (Encoding, FromJSON (parseJSON), GFromJSON, GToEncoding, GToJSON, Options (fieldLabelModifier), ToJSON (toEncoding, toJSON), Value (..), Zero, defaultOptions, genericParseJSON, genericToEncoding, genericToJSON, withObject)
+import Data.Aeson.BetterErrors qualified as Json
+import Data.Aeson.Encoding qualified as Enc
+import Data.Aeson.Key qualified as Key
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Char qualified
+import Data.Error.Tree
+import Data.Foldable qualified as Foldable
+import Data.Int (Int64)
+import Data.List (isPrefixOf)
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Maybe (catMaybes)
+import Data.String (IsString (fromString))
+import Data.Text.Lazy qualified as Lazy
+import Data.Vector qualified as Vector
+import GHC.Generics (Generic (Rep))
+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
+import Label
+import MyPrelude
+import Test.Hspec (describe, it, shouldBe)
+import Test.Hspec qualified as Hspec
+
+-- | Convert a 'Json.ParseError' to a corresponding 'ErrorTree'
+parseErrorTree :: Error -> Json.ParseError Error -> ErrorTree
+parseErrorTree contextMsg errs =
+  errs
+    & Json.displayError prettyError
+    <&> newError
+    & nonEmpty
+    & \case
+      Nothing -> singleError contextMsg
+      Just errs' -> errorTree contextMsg errs'
+
+-- | Parse a key from the object, à la 'Json.key', return a labelled value.
+--
+-- We don’t provide a version that infers the json object key,
+-- since that conflates internal naming with the external API, which is dangerous.
+--
+-- @@
+-- do
+--   txt <- keyLabel @"myLabel" "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" Text)
+-- @@
+keyLabel ::
+  forall label err m a.
+  Monad m =>
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label a)
+keyLabel = do
+  keyLabel' (Proxy @label)
+
+-- | Parse a key from the object, à la 'Json.key', return a labelled value.
+-- Version of 'keyLabel' that requires a proxy.
+--
+-- @@
+-- do
+--   txt <- keyLabel' (Proxy @"myLabel") "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" Text)
+-- @@
+keyLabel' ::
+  forall label err m a.
+  Monad m =>
+  Proxy label ->
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label a)
+keyLabel' Proxy key parser = label @label <$> Json.key key parser
+
+-- | Parse an optional key from the object, à la 'Json.keyMay', return a labelled value.
+--
+-- We don’t provide a version that infers the json object key,
+-- since that conflates internal naming with the external API, which is dangerous.
+--
+-- @@
+-- do
+--   txt <- keyLabelMay @"myLabel" "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" (Maybe Text))
+-- @@
+keyLabelMay ::
+  forall label err m a.
+  Monad m =>
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label (Maybe a))
+keyLabelMay = do
+  keyLabelMay' (Proxy @label)
+
+-- | Parse an optional key from the object, à la 'Json.keyMay', return a labelled value.
+-- Version of 'keyLabelMay' that requires a proxy.
+--
+-- @@
+-- do
+--   txt <- keyLabelMay' (Proxy @"myLabel") "jsonKeyName" Json.asText
+--   pure (txt :: Label "myLabel" (Maybe Text))
+-- @@
+keyLabelMay' ::
+  forall label err m a.
+  Monad m =>
+  Proxy label ->
+  Text ->
+  Json.ParseT err m a ->
+  Json.ParseT err m (Label label (Maybe a))
+keyLabelMay' Proxy key parser = label @label <$> Json.keyMay key parser
+
+-- | Like 'Json.key', but allows a list of keys that are tried in order.
+--
+-- This is intended for renaming keys in an object.
+-- The first key is the most up-to-date version of a key, the others are for backward-compatibility.
+--
+-- If a key (new or old) exists, the inner parser will always be executed for that key.
+keyRenamed :: Monad m => NonEmpty Text -> Json.ParseT err m a -> Json.ParseT err m a
+keyRenamed (newKey :| oldKeys) inner =
+  keyRenamedTryOldKeys oldKeys inner >>= \case
+    Nothing -> Json.key newKey inner
+    Just parse -> parse
+
+-- | Like 'Json.keyMay', but allows a list of keys that are tried in order.
+--
+-- This is intended for renaming keys in an object.
+-- The first key is the most up-to-date version of a key, the others are for backward-compatibility.
+--
+-- If a key (new or old) exists, the inner parser will always be executed for that key.
+keyRenamedMay :: Monad m => NonEmpty Text -> Json.ParseT err m a -> Json.ParseT err m (Maybe a)
+keyRenamedMay (newKey :| oldKeys) inner =
+  keyRenamedTryOldKeys oldKeys inner >>= \case
+    Nothing -> Json.keyMay newKey inner
+    Just parse -> Just <$> parse
+
+-- | Helper function for 'keyRenamed' and 'keyRenamedMay' that returns the parser for the first old key that exists, if any.
+keyRenamedTryOldKeys :: Monad m => [Text] -> Json.ParseT err m a -> Json.ParseT err m (Maybe (Json.ParseT err m a))
+keyRenamedTryOldKeys oldKeys inner = do
+  oldKeys & traverse tryOld <&> catMaybes <&> nonEmpty <&> \case
+    Nothing -> Nothing
+    Just (old :| _moreOld) -> Just old
+  where
+    tryOld key =
+      Json.keyMay key (pure ()) <&> \case
+        Just () -> Just $ Json.key key inner
+        Nothing -> Nothing
+
+test_keyRenamed :: Hspec.Spec
+test_keyRenamed = do
+  describe "keyRenamed" $ do
+    let parser = keyRenamed ("new" :| ["old"]) Json.asText
+    let p = Json.parseValue @() parser
+    it "accepts the new key and the old key" $ do
+      p (Object (KeyMap.singleton "new" (String "text")))
+        `shouldBe` (Right "text")
+      p (Object (KeyMap.singleton "old" (String "text")))
+        `shouldBe` (Right "text")
+    it "fails with the old key in the error if the inner parser is wrong" $ do
+      p (Object (KeyMap.singleton "old" Null))
+        `shouldBe` (Left (Json.BadSchema [Json.ObjectKey "old"] (Json.WrongType Json.TyString Null)))
+    it "fails with the new key in the error if the inner parser is wrong" $ do
+      p (Object (KeyMap.singleton "new" Null))
+        `shouldBe` (Left (Json.BadSchema [Json.ObjectKey "new"] (Json.WrongType Json.TyString Null)))
+    it "fails if the key is missing" $ do
+      p (Object KeyMap.empty)
+        `shouldBe` (Left (Json.BadSchema [] (Json.KeyMissing "new")))
+  describe "keyRenamedMay" $ do
+    let parser = keyRenamedMay ("new" :| ["old"]) Json.asText
+    let p = Json.parseValue @() parser
+    it "accepts the new key and the old key" $ do
+      p (Object (KeyMap.singleton "new" (String "text")))
+        `shouldBe` (Right (Just "text"))
+      p (Object (KeyMap.singleton "old" (String "text")))
+        `shouldBe` (Right (Just "text"))
+    it "allows the old and new key to be missing" $ do
+      p (Object KeyMap.empty)
+        `shouldBe` (Right Nothing)
+
+-- | Create a json array from a list of json values.
+jsonArray :: [Value] -> Value
+jsonArray xs = xs & Vector.fromList & Array
diff --git a/users/Profpatsch/my-prelude/Data/Error/Tree.hs b/users/Profpatsch/my-prelude/Data/Error/Tree.hs
new file mode 100644
index 000000000000..e8e45e704882
--- /dev/null
+++ b/users/Profpatsch/my-prelude/Data/Error/Tree.hs
@@ -0,0 +1,113 @@
+{-# 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
diff --git a/users/Profpatsch/my-prelude/default.nix b/users/Profpatsch/my-prelude/default.nix
index 87731394fc47..8ff36a93d4e4 100644
--- a/users/Profpatsch/my-prelude/default.nix
+++ b/users/Profpatsch/my-prelude/default.nix
@@ -9,11 +9,15 @@ pkgs.haskellPackages.mkDerivation {
     ./MyPrelude.hs
     ./Label.hs
     ./Pretty.hs
+    ./Data/Error/Tree.hs
+    ./Aeson.hs
   ];
 
   isLibrary = true;
 
   libraryHaskellDepends = [
+    pkgs.haskellPackages.aeson
+    pkgs.haskellPackages.aeson-better-errors
     pkgs.haskellPackages.PyF
     pkgs.haskellPackages.errors
     pkgs.haskellPackages.profunctors
@@ -21,10 +25,12 @@ pkgs.haskellPackages.mkDerivation {
     pkgs.haskellPackages.these
     pkgs.haskellPackages.validation-selective
     pkgs.haskellPackages.error
-
+    pkgs.haskellPackages.hspec
+    pkgs.haskellPackages.hspec-expectations-pretty-diff
     pkgs.haskellPackages.hscolour
     pkgs.haskellPackages.nicify-lib
     pkgs.haskellPackages.ansi-terminal
+    pkgs.haskellPackages.vector
   ];
 
   license = lib.licenses.mit;
diff --git a/users/Profpatsch/my-prelude/my-prelude.cabal b/users/Profpatsch/my-prelude/my-prelude.cabal
index 48e71bb926a3..8ee3271d10fa 100644
--- a/users/Profpatsch/my-prelude/my-prelude.cabal
+++ b/users/Profpatsch/my-prelude/my-prelude.cabal
@@ -9,6 +9,8 @@ library
       MyPrelude
       Label
       Pretty
+      Data.Error.Tree
+      Aeson
 
     -- Modules included in this executable, other than Main.
     -- other-modules:
@@ -17,6 +19,8 @@ library
     -- other-extensions:
     build-depends:
        base >=4.15 && <5
+     , aeson
+     , aeson-better-errors
      , PyF
      , validation-selective
      , these
@@ -27,7 +31,10 @@ library
      , error
      , bytestring
      , mtl
+     , hspec
+     , hspec-expectations-pretty-diff
      , hscolour
      , nicify-lib
      , ansi-terminal
+     , vector
     default-language: Haskell2010