mirror of
https://github.com/i-am-tom/higgledy.git
synced 2024-08-17 03:50:23 +03:00
Remove argument from label
It doesn't need one, and it just opens up more opportunities for type ambiguities. Type-applying will go much better.
This commit is contained in:
parent
ce88cc5f0b
commit
7527a89678
@ -264,12 +264,12 @@ eg14 = deconstruct @Identity triple ^. position @4
|
||||
### Labels
|
||||
|
||||
One neat trick we can do - thanks to the generic representation - is get the
|
||||
names of the fields into the functor we're using. The `label` function gives us
|
||||
names of the fields into the functor we're using. The `label` value gives us
|
||||
this interface:
|
||||
|
||||
```haskell
|
||||
eg15 :: Labels User
|
||||
eg15 = label eg13
|
||||
eg15 = label
|
||||
-- User
|
||||
-- { name = Const "name"
|
||||
-- , age = Const "age"
|
||||
|
@ -31,20 +31,20 @@ import GHC.TypeLits (ErrorMessage (..), KnownSymbol, TypeError, symbolVal)
|
||||
-- >>> import Data.Functor.Identity (Identity (..))
|
||||
--
|
||||
-- >>> data User = User { name :: String, age :: Int } deriving Generic
|
||||
-- >>> label (deconstruct @Identity (User "Tom" 25))
|
||||
-- >>> label @User
|
||||
-- User {name = Const "name", age = Const "age"}
|
||||
class Label (structure :: Type) where
|
||||
label :: HKD structure f -> HKD structure (Const String)
|
||||
label :: HKD structure (Const String)
|
||||
|
||||
class GLabels (rep :: Type -> Type) where
|
||||
glabel :: GHKD_ f rep p -> GHKD_ (Const String) rep p
|
||||
glabel :: GHKD_ (Const String) rep p
|
||||
|
||||
instance GLabels inner => GLabels (D1 meta inner) where
|
||||
glabel = M1 . glabel . unM1
|
||||
glabel = M1 glabel
|
||||
|
||||
instance GLabels inner
|
||||
=> GLabels (C1 ('MetaCons name fixity 'True) inner) where
|
||||
glabel = M1 . glabel . unM1
|
||||
glabel = M1 glabel
|
||||
|
||||
instance TypeError ('Text "You can't collect labels for a non-record type!")
|
||||
=> GLabels (C1 ('MetaCons name fixity 'False) inner) where
|
||||
@ -52,13 +52,13 @@ instance TypeError ('Text "You can't collect labels for a non-record type!")
|
||||
|
||||
instance KnownSymbol name
|
||||
=> GLabels (S1 ('MetaSel ('Just name) i d c) (K1 index inner)) where
|
||||
glabel _ = M1 (K1 (Const (symbolVal (Proxy @name))))
|
||||
glabel = M1 (K1 (Const (symbolVal (Proxy @name))))
|
||||
|
||||
instance (GLabels left, GLabels right) => GLabels (left :*: right) where
|
||||
glabel (left :*: right) = glabel left :*: glabel right
|
||||
glabel = glabel :*: glabel
|
||||
|
||||
instance (Generic structure, GLabels (Rep structure)) => Label structure where
|
||||
label = HKD . glabel . runHKD
|
||||
label = HKD glabel
|
||||
|
||||
-- | Because all HKD types are valid barbies, and we have the above mechanism
|
||||
-- for extracting field names, we can ask some pretty interesting questions.
|
||||
@ -90,8 +90,8 @@ labelsWhere
|
||||
-> HKD structure f
|
||||
-> [String]
|
||||
|
||||
labelsWhere p xs
|
||||
= getConst (btraverse go (label xs `bprod` xs))
|
||||
labelsWhere p
|
||||
= getConst . btraverse go . bprod label
|
||||
where
|
||||
go :: Product (Const String) f a -> (Const [String]) (Maybe a)
|
||||
go (Pair (Const key) value) = Const if p value then [key] else []
|
||||
|
Loading…
Reference in New Issue
Block a user