feat(users/Profpatsch/mailbox-org): init r/5560

A smol little tool to talk to the mailbox.org backend. This is handy
for eventually setting stuff like email filters. Their API is absolute
crap, but we’ll deal with it.

Updates the prelude & adds some pretty printing helpers.

Change-Id: Ie3688f8ee1d7f23c65bcf4bfecc00c8269dae788
Reviewed-on: https://cl.tvl.fyi/c/depot/+/7717
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

1 files changed, 91 insertions, 45 deletions

diff --git a/users/Profpatsch/my-prelude/MyPrelude.hs b/users/Profpatsch/my-prelude/MyPrelude.hs
index a2c99bc9ead2..4ef59c05ffba 100644
--- a/users/Profpatsch/my-prelude/MyPrelude.hs
+++ b/users/Profpatsch/my-prelude/MyPrelude.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GHC2021 #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MagicHash #-}
@@ -5,6 +6,7 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
 
 module MyPrelude
   ( -- * Text conversions
@@ -37,6 +39,9 @@ module MyPrelude
     -- * WIP code
     todo,
 
+    -- * Records
+    HasField,
+
     -- * Control flow
     (&),
     (<&>),
@@ -59,9 +64,11 @@ module MyPrelude
     first,
     second,
     bimap,
+    both,
     foldMap,
     fold,
     foldl',
+    fromMaybe,
     mapMaybe,
     findMaybe,
     Traversable,
@@ -105,6 +112,8 @@ module MyPrelude
     sconcat,
     Monoid,
     mconcat,
+    ifTrue,
+    ifExists,
     Void,
     absurd,
     Identity (Identity, runIdentity),
@@ -120,8 +129,8 @@ module MyPrelude
     rmap,
     Semigroupoid,
     Category,
-    (<<<),
     (>>>),
+    (&>>),
 
     -- * Enum definition
     inverseFunction,
@@ -130,12 +139,11 @@ module MyPrelude
     -- * Error handling
     HasCallStack,
     module Data.Error,
-    smushErrors,
   )
 where
 
 import Control.Applicative ((<|>))
-import Control.Category (Category, (<<<), (>>>))
+import Control.Category (Category, (>>>))
 import Control.Monad (guard, join, unless, when)
 import Control.Monad.Except
   ( ExceptT,
@@ -150,13 +158,13 @@ import Data.Bifunctor (Bifunctor, bimap, first, second)
 import Data.ByteString
   ( ByteString,
   )
-import qualified Data.ByteString.Lazy
-import qualified Data.Char
+import Data.ByteString.Lazy qualified
+import Data.Char qualified
 import Data.Coerce (Coercible, coerce)
 import Data.Data (Proxy (Proxy))
 import Data.Error
 import Data.Foldable (Foldable (foldMap', toList), fold, foldl', for_, traverse_)
-import qualified Data.Foldable as Foldable
+import Data.Foldable qualified as Foldable
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.Functor.Contravariant (Contravariant (contramap), (>$<))
@@ -165,22 +173,22 @@ import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.Map.Strict
   ( Map,
   )
-import qualified Data.Map.Strict as Map
-import Data.Maybe (mapMaybe)
-import qualified Data.Maybe as Maybe
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe qualified as Maybe
 import Data.Profunctor (Profunctor, dimap, lmap, rmap)
 import Data.Semigroup (Max (Max, getMax), Min (Min, getMin), sconcat)
 import Data.Semigroup.Foldable (Foldable1 (fold1), foldMap1)
 import Data.Semigroup.Traversable (Traversable1)
-import Data.Semigroupoid (Semigroupoid)
+import Data.Semigroupoid (Semigroupoid (o))
 import Data.Text
   ( Text,
   )
-import qualified Data.Text
-import qualified Data.Text.Encoding
-import qualified Data.Text.Encoding.Error
-import qualified Data.Text.Lazy
-import qualified Data.Text.Lazy.Encoding
+import Data.Text qualified
+import Data.Text.Encoding qualified
+import Data.Text.Encoding.Error qualified
+import Data.Text.Lazy qualified
+import Data.Text.Lazy.Encoding qualified
 import Data.These (These (That, These, This))
 import Data.Traversable (for)
 import Data.Void (Void, absurd)
@@ -189,10 +197,11 @@ import GHC.Exception (errorCallWithCallStackException)
 import GHC.Exts (RuntimeRep, TYPE, raise#)
 import GHC.Generics (Generic)
 import GHC.Natural (Natural)
+import GHC.Records (HasField)
 import GHC.Stack (HasCallStack)
 import PyF (fmt)
-import qualified System.Exit
-import qualified System.IO
+import System.Exit qualified
+import System.IO qualified
 import Validation
   ( Validation (Failure, Success),
     eitherToValidation,
@@ -208,6 +217,20 @@ import Validation
 
 infixl 5 >&<
 
+-- | Forward semigroupoid application. The same as '(>>>)', but 'Semigroupoid' is not a superclass of 'Category' (yet).
+--
+-- Specialized examples:
+--
+-- @@
+-- for functions : (a -> b) -> (b -> c) -> (a -> c)
+-- for Folds: Fold a b -> Fold b c -> Fold a c
+-- @@
+(&>>) :: Semigroupoid s => s a b -> s b c -> s a c
+(&>>) = flip Data.Semigroupoid.o
+
+-- like >>>
+infixr 1 &>>
+
 -- | encode a Text to a UTF-8 encoded Bytestring
 textToBytesUtf8 :: Text -> ByteString
 textToBytesUtf8 = Data.Text.Encoding.encodeUtf8
@@ -309,6 +332,10 @@ annotate err = \case
   Nothing -> Left err
   Just a -> Right a
 
+-- | Map the same function over both sides of a Bifunctor (e.g. a tuple).
+both :: Bifunctor bi => (a -> b) -> bi a a -> bi b b
+both f = bimap f f
+
 -- | Find the first element for which pred returns `Just a`, and return the `a`.
 --
 -- Example:
@@ -430,33 +457,6 @@ traverseFold1 f xs = fold1 <$> traverse f xs
 todo :: forall (r :: RuntimeRep). forall (a :: TYPE r). HasCallStack => a
 todo = raise# (errorCallWithCallStackException "This code was not yet implemented: TODO" ?callStack)
 
--- TODO: use a Text.Builder?
-
--- | Pretty print a bunch of errors, on multiple lines, prefixed by the given message,
--- then turn the result back into an 'Error'.
---
--- Example:
---
--- smushErrors "There was a problem with the frobl"
---   [ (anyhow "frobz")
---   , (errorContext "oh no" (anyhow "barz"))
---   ]
---
--- ==>
--- "There was a problem with the frobl\n\
--- - frobz\n\
--- - oh no: barz\n"
--- @
---
--- TODO how do we make this compatible with/integrate it into the Error library?
-smushErrors :: Foldable t => Text -> t Error -> Error
-smushErrors msg errs =
-  errs
-    -- hrm, pretty printing and then creating a new error is kinda shady
-    & foldMap (\err -> "\n- " <> prettyError err)
-    & newError
-    & errorContext msg
-
 -- | Convert an integer to a 'Natural' if possible
 --
 -- Named the same as the function from "GHC.Natural", but does not crash.
@@ -536,5 +536,51 @@ inverseMap f =
     <&> (\a -> (f a, a))
     & Map.fromList
   where
-    universe :: (Bounded a, Enum a) => [a]
+    universe :: [a]
     universe = [minBound .. maxBound]
+
+-- | If the predicate is true, return the @m@, else 'mempty'.
+--
+-- This can be used (together with `ifExists`) to e.g. create lists with optional elements:
+--
+-- >>> import Data.Monoid (Sum(..))
+--
+-- >>> :{ mconcat [
+--   ifTrue (1 == 1) [1],
+--   [2, 3, 4],
+--   ifTrue False [5],
+-- ]
+-- :}
+-- [1,2,3,4]
+--
+-- Or any other Monoid:
+--
+-- >>> mconcat [ Sum 1, ifTrue (1 == 1) (Sum 2), Sum 3 ]
+
+-- Sum {getSum = 6}
+
+ifTrue :: Monoid m => Bool -> m -> m
+ifTrue pred' m = if pred' then m else mempty
+
+-- | If the given @Maybe@ is @Just@, return the @m@, else return mempty.
+
+-- This can be used (together with `ifTrue`) to e.g. create lists with optional elements:
+--
+-- >>> import Data.Monoid (Sum(..))
+--
+-- >>> :{ mconcat [
+--   ifExists (Just [1]),
+--   [2, 3, 4],
+--   ifExists Nothing,
+-- ]
+-- :}
+-- [1,2,3,4]
+--
+-- Or any other Monoid:
+--
+-- >>> mconcat [ Sum 1, ifExists (Just (Sum 2)), Sum 3 ]
+
+-- Sum {getSum = 6}
+
+ifExists :: Monoid m => Maybe m -> m
+ifExists = fold