diff options
author | Profpatsch <mail@profpatsch.de> | 2023-05-28T15·20+0200 |
---|---|---|
committer | Profpatsch <mail@profpatsch.de> | 2023-07-13T20·50+0000 |
commit | 6a15e8e71ab318b47e4c62d90f8e541b45df7fd4 (patch) | |
tree | 2c3a0401444f4447eca98b51fe742de36a1c83ce /users/Profpatsch | |
parent | 909b4fafb8ffc9574fd1f09673893802f6510deb (diff) |
chore(users/Profpatsch): replace Label with pa-label r/6407
We upstreamed some of these modules to hackage, so I can get rid of it here. Change-Id: I70e1e864a81029cadbbd96cc019a768728431cff Reviewed-on: https://cl.tvl.fyi/c/depot/+/8659 Reviewed-by: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI Autosubmit: Profpatsch <mail@profpatsch.de> Reviewed-by: sterni <sternenseemann@systemli.org>
Diffstat (limited to 'users/Profpatsch')
-rw-r--r-- | users/Profpatsch/mailbox-org/default.nix | 1 | ||||
-rw-r--r-- | users/Profpatsch/mailbox-org/mailbox-org.cabal | 1 | ||||
-rw-r--r-- | users/Profpatsch/my-prelude/Label.hs | 120 | ||||
-rw-r--r-- | users/Profpatsch/my-prelude/default.nix | 2 | ||||
-rw-r--r-- | users/Profpatsch/my-prelude/my-prelude.cabal | 2 | ||||
-rw-r--r-- | users/Profpatsch/shell.nix | 8 |
6 files changed, 11 insertions, 123 deletions
diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix index cd419047223f..0387c7b12de3 100644 --- a/users/Profpatsch/mailbox-org/default.nix +++ b/users/Profpatsch/mailbox-org/default.nix @@ -15,6 +15,7 @@ let depot.users.Profpatsch.my-prelude depot.users.Profpatsch.execline.exec-helpers-hs depot.users.Profpatsch.arglib.netencode.haskell + pkgs.haskellPackages.pa-prelude pkgs.haskellPackages.aeson pkgs.haskellPackages.http-conduit pkgs.haskellPackages.aeson-better-errors diff --git a/users/Profpatsch/mailbox-org/mailbox-org.cabal b/users/Profpatsch/mailbox-org/mailbox-org.cabal index fe65da409df6..c4b04ce66de2 100644 --- a/users/Profpatsch/mailbox-org/mailbox-org.cabal +++ b/users/Profpatsch/mailbox-org/mailbox-org.cabal @@ -10,6 +10,7 @@ executable mailbox-org build-depends: base >=4.15 && <5, my-prelude, + pa-label, exec-helpers, netencode, text, diff --git a/users/Profpatsch/my-prelude/Label.hs b/users/Profpatsch/my-prelude/Label.hs deleted file mode 100644 index 01b49353b987..000000000000 --- a/users/Profpatsch/my-prelude/Label.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GHC2021 #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -module Label - ( Label, - label, - label', - getLabel, - T2 (..), - T3 (..), - ) -where - -import Data.Data (Proxy (..)) -import Data.Function ((&)) -import Data.Typeable (Typeable) -import GHC.Records (HasField (..)) -import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) - --- | A labelled value. --- --- Use 'label'/'label'' to construct, --- then use dot-syntax to get the inner value. -newtype Label (label :: Symbol) value = Label value - deriving stock (Eq, Ord) - deriving newtype (Typeable, Semigroup, Monoid) - -instance (KnownSymbol label, Show value) => Show (Label label value) where - showsPrec d (Label val) = - showParen (d > 10) $ - showString "Label @" - . showsPrec 11 (symbolVal (Proxy @label)) - . showString " " - . showsPrec 11 val - --- | Attach a label to a value; should be used with a type application to name the label. --- --- @@ --- let f = label @"foo" 'f' :: Label "foo" Char --- in f.foo :: Char --- @@ --- --- Use dot-syntax to get the labelled value. -label :: forall label value. value -> Label label value -label value = Label value - --- | Attach a label to a value; Pass it a proxy with the label name in the argument type. --- This is intended for passing through the label value; --- you can also use 'label'. --- --- --- @@ --- let f = label' (Proxy @"foo") 'f' :: Label "foo" Char --- in f.foo :: Char --- @@ --- --- Use dot-syntax to get the labelled value. -label' :: forall label value. (Proxy label) -> value -> Label label value -label' Proxy value = Label value - --- | Fetches the labelled value. -instance HasField label (Label label value) value where - getField :: (Label label value) -> value - getField (Label value) = value - --- | Fetch a value from a record, like 'getField', but also keep it wrapped by its label. -getLabel :: forall label record a. HasField label record a => record -> Label label a -getLabel rec = rec & getField @label & label @label - --- | A named 2-element tuple. Since the elements are named, you can access them with `.`. --- --- @@ --- let t2 = T2 (label @"myfield" 'c') (label @"otherfield" True) :: T2 "myfield" Char "otherfield" Bool --- in ( --- t2.myfield :: Char, --- t2.otherfield :: Bool --- ) --- @@ -data T2 (l1 :: Symbol) t1 (l2 :: Symbol) t2 = T2 (Label l1 t1) (Label l2 t2) - --- | Access the first field by label -instance HasField l1 (T2 l1 t1 l2 t2) t1 where - getField (T2 t1 _) = getField @l1 t1 - --- | Access the second field by label -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) - --- | Access the first field by label -instance HasField l1 (T3 l1 t1 l2 t2 l3 t3) t1 where - getField (T3 t1 _ _) = getField @l1 t1 - --- | Access the second field by label -instance HasField l2 (T3 l1 t1 l2 t2 l3 t3) t2 where - getField (T3 _ t2 _) = getField @l2 t2 - --- | 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 diff --git a/users/Profpatsch/my-prelude/default.nix b/users/Profpatsch/my-prelude/default.nix index 4d854b194b39..1fa8075c523c 100644 --- a/users/Profpatsch/my-prelude/default.nix +++ b/users/Profpatsch/my-prelude/default.nix @@ -7,7 +7,6 @@ pkgs.haskellPackages.mkDerivation { src = depot.users.Profpatsch.exactSource ./. [ ./my-prelude.cabal ./MyPrelude.hs - ./Label.hs ./Pretty.hs ./Data/Error/Tree.hs ./Aeson.hs @@ -18,6 +17,7 @@ pkgs.haskellPackages.mkDerivation { isLibrary = true; libraryHaskellDepends = [ + pkgs.haskellPackages.pa-label pkgs.haskellPackages.aeson pkgs.haskellPackages.aeson-better-errors pkgs.haskellPackages.PyF diff --git a/users/Profpatsch/my-prelude/my-prelude.cabal b/users/Profpatsch/my-prelude/my-prelude.cabal index 94f9c9e77417..283f9f71375f 100644 --- a/users/Profpatsch/my-prelude/my-prelude.cabal +++ b/users/Profpatsch/my-prelude/my-prelude.cabal @@ -7,7 +7,6 @@ maintainer: mail@profpatsch.de library exposed-modules: MyPrelude - Label Pretty Data.Error.Tree Aeson @@ -21,6 +20,7 @@ library -- other-extensions: build-depends: base >=4.15 && <5 + , pa-label , aeson , aeson-better-errors , PyF diff --git a/users/Profpatsch/shell.nix b/users/Profpatsch/shell.nix index 3420bcdb0ace..640be96cd0ef 100644 --- a/users/Profpatsch/shell.nix +++ b/users/Profpatsch/shell.nix @@ -12,14 +12,21 @@ pkgs.mkShell { (pkgs.haskellPackages.ghcWithHoogle (h: [ h.async h.aeson-better-errors + h.blaze-html h.conduit-extra h.error + h.monad-logger + h.pa-field-parser + h.pa-label + h.ihp-hsx h.PyF h.unliftio h.wai + h.wai-extra h.warp h.profunctors h.semigroupoids + h.servant-multipart h.validation-selective h.free h.cryptonite-conduit @@ -40,7 +47,6 @@ pkgs.mkShell { depot.users.Profpatsch.netencode.netencode-hs depot.users.Profpatsch.arglib.netencode.haskell depot.users.Profpatsch.execline.exec-helpers-hs - ])) pkgs.rustup |