about summary refs log tree commit diff
path: root/users/Profpatsch
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2023-05-28T15·20+0200
committerProfpatsch <mail@profpatsch.de>2023-07-13T20·50+0000
commit6a15e8e71ab318b47e4c62d90f8e541b45df7fd4 (patch)
tree2c3a0401444f4447eca98b51fe742de36a1c83ce /users/Profpatsch
parent909b4fafb8ffc9574fd1f09673893802f6510deb (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.nix1
-rw-r--r--users/Profpatsch/mailbox-org/mailbox-org.cabal1
-rw-r--r--users/Profpatsch/my-prelude/Label.hs120
-rw-r--r--users/Profpatsch/my-prelude/default.nix2
-rw-r--r--users/Profpatsch/my-prelude/my-prelude.cabal2
-rw-r--r--users/Profpatsch/shell.nix8
6 files changed, 11 insertions, 123 deletions
diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix
index cd41904722..0387c7b12d 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 fe65da409d..c4b04ce66d 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 01b49353b9..0000000000
--- 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 4d854b194b..1fa8075c52 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 94f9c9e774..283f9f7137 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 3420bcdb0a..640be96cd0 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