diff options
author | Profpatsch <mail@profpatsch.de> | 2023-01-02T11·51+0100 |
---|---|---|
committer | Profpatsch <mail@profpatsch.de> | 2023-01-05T22·10+0000 |
commit | 30ec1adce82696fb270bf6e000157bf527fd9c05 (patch) | |
tree | 5dcb3124e97bf01f80485c37d1b5114dfdd30133 /users/Profpatsch/my-prelude/Label.hs | |
parent | 95c9c2ae8b3bf81afaee8f0baf408257c1f60454 (diff) |
feat(users/Profpatsch/mailbox-org): prepare adjusting filter config r/5593
In the end, it should be possible to write a single config which is pushed to the service to steer which emails arrive. This implements some helper functions and some more endpoints. We implement Semigroup/Monoid for labelled tuples. Change-Id: I48bfd311e4a7bba5bc08a9681d823a6a7d5175a8 Reviewed-on: https://cl.tvl.fyi/c/depot/+/7727 Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/my-prelude/Label.hs')
-rw-r--r-- | users/Profpatsch/my-prelude/Label.hs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/users/Profpatsch/my-prelude/Label.hs b/users/Profpatsch/my-prelude/Label.hs index 0e339758ddbd..01b49353b987 100644 --- a/users/Profpatsch/my-prelude/Label.hs +++ b/users/Profpatsch/my-prelude/Label.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GHC2021 #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} @@ -28,7 +29,7 @@ import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) -- then use dot-syntax to get the inner value. newtype Label (label :: Symbol) value = Label value deriving stock (Eq, Ord) - deriving newtype (Typeable) + deriving newtype (Typeable, Semigroup, Monoid) instance (KnownSymbol label, Show value) => Show (Label label value) where showsPrec d (Label val) = @@ -91,6 +92,12 @@ instance HasField l1 (T2 l1 t1 l2 t2) t1 where instance HasField l2 (T2 l1 t1 l2 t2) t2 where getField (T2 _ t2) = getField @l2 t2 +instance (Semigroup t1, Semigroup t2) => Semigroup (T2 l1 t1 l2 t2) where + T2 t1 t2 <> T2 t1' t2' = T2 (t1 <> t1') (t2 <> t2') + +instance (Monoid t1, Monoid t2) => Monoid (T2 l1 t1 l2 t2) where + mempty = T2 mempty mempty + -- | A named 3-element tuple. Since the elements are named, you can access them with `.`. See 'T2' for an example. data T3 (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3 = T3 (Label l1 t1) (Label l2 t2) (Label l3 t3) @@ -105,3 +112,9 @@ instance HasField l2 (T3 l1 t1 l2 t2 l3 t3) t2 where -- | Access the third field by label instance HasField l3 (T3 l1 t1 l2 t2 l3 t3) t3 where getField (T3 _ _ t3) = getField @l3 t3 + +instance (Semigroup t1, Semigroup t2, Semigroup t3) => Semigroup (T3 l1 t1 l2 t2 l3 t3) where + T3 t1 t2 t3 <> T3 t1' t2' t3' = T3 (t1 <> t1') (t2 <> t2') (t3 <> t3') + +instance (Monoid t1, Monoid t2, Monoid t3) => Monoid (T3 l1 t1 l2 t2 l3 t3) where + mempty = T3 mempty mempty mempty |