chore(users/Profpatsch): replace Label with pa-label

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>
This commit is contained in:
Profpatsch 2023-05-28 17:20:48 +02:00
parent 909b4fafb8
commit 6a15e8e71a
11 changed files with 108 additions and 123 deletions

View file

@ -29,6 +29,11 @@ in
# TODO: this is to fix a bug in dhall-nix
dhall = dhall-source "dhall" hsSuper.dhall;
dhall-nix = dhall-source "dhall-nix" hsSuper.dhall-nix;
pa-prelude = hsSelf.callPackage ./extra-pkgs/pa-prelude-0.1.0.0.nix { };
pa-error-tree = hsSelf.callPackage ./extra-pkgs/pa-error-tree-0.1.0.0.nix { };
pa-field-parser = hsSelf.callPackage ./extra-pkgs/pa-field-parser-0.1.0.1.nix { };
pa-label = hsSelf.callPackage ./extra-pkgs/pa-label-0.1.0.1.nix { };
};
};

View file

@ -0,0 +1,10 @@
{ mkDerivation, base, containers, lib, pa-prelude }:
mkDerivation {
pname = "pa-error-tree";
version = "0.1.0.0";
sha256 = "f82d3d905e8d9f0d31c81f31c424b9a95c65a8925517ccac92134f410cf8d639";
libraryHaskellDepends = [ base containers pa-prelude ];
homepage = "https://github.com/possehl-analytics/pa-hackage";
description = "Collect a tree of errors and pretty-print";
license = lib.licenses.bsd3;
}

View file

@ -0,0 +1,35 @@
{ mkDerivation
, aeson
, aeson-better-errors
, attoparsec
, base
, case-insensitive
, containers
, lib
, pa-error-tree
, pa-prelude
, scientific
, semigroupoids
, text
}:
mkDerivation {
pname = "pa-field-parser";
version = "0.1.0.1";
sha256 = "e7fd0369898b6993e6e2aaab43e7cc84d173dc2d21eadca1884d2e7a780ad71f";
libraryHaskellDepends = [
aeson
aeson-better-errors
attoparsec
base
case-insensitive
containers
pa-error-tree
pa-prelude
scientific
semigroupoids
text
];
homepage = "https://github.com/possehl-analytics/pa-hackage";
description = "Vertical parsing of values";
license = lib.licenses.bsd3;
}

View file

@ -0,0 +1,10 @@
{ mkDerivation, base, lib }:
mkDerivation {
pname = "pa-label";
version = "0.1.0.1";
sha256 = "0131ab7718d910a94cd8cc881e51b7371a060dadfeabc8fd78513a7f27ee8d35";
libraryHaskellDepends = [ base ];
homepage = "https://github.com/possehl-analytics/pa-hackage";
description = "Labels, and labelled tuples and enums (GHC >9.2)";
license = lib.licenses.bsd3;
}

View file

@ -0,0 +1,37 @@
{ mkDerivation
, base
, bytestring
, containers
, error
, exceptions
, lib
, mtl
, profunctors
, PyF
, semigroupoids
, text
, these
, validation-selective
}:
mkDerivation {
pname = "pa-prelude";
version = "0.1.0.0";
sha256 = "554556e3acbf7154131ed05209d803a19d6aa1c7d675fcb10501de50869c49ab";
libraryHaskellDepends = [
base
bytestring
containers
error
exceptions
mtl
profunctors
PyF
semigroupoids
text
these
validation-selective
];
homepage = "https://github.com/possehl-analytics/pa-hackage";
description = "The Possehl Analytics Prelude";
license = lib.licenses.bsd3;
}

View file

@ -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

View file

@ -10,6 +10,7 @@ executable mailbox-org
build-depends:
base >=4.15 && <5,
my-prelude,
pa-label,
exec-helpers,
netencode,
text,

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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