mirror of
https://github.com/i-am-tom/higgledy.git
synced 2024-08-17 03:50:23 +03:00
Code review changes
Thanks @neongreen and @int-index!
This commit is contained in:
parent
049af746be
commit
ba5fc87669
10
README.md
10
README.md
@ -38,7 +38,7 @@ type UserF f = HKD User f
|
||||
```
|
||||
|
||||
As an added little bonus, any `HKD`-wrapped object is automatically an instance
|
||||
of all the [Barbie](http://hackage.haskell.org/package/barbies) classes, so no
|
||||
of all the [Barbie](https://hackage.haskell.org/package/barbies) classes, so no
|
||||
need to derive anything more than `Generic`!
|
||||
|
||||
## API
|
||||
@ -188,7 +188,7 @@ eg7 = eg6 [1] [] ["Tom", "Tim"]
|
||||
```
|
||||
|
||||
Should we need to work with records, we can exploit the label trickery of the
|
||||
[`named`](http://hackage.haskell.org/package/named) package. The `record`
|
||||
[`named`](https://hackage.haskell.org/package/named) package. The `record`
|
||||
function behaves exactly as `build` does, but produces a function compatible
|
||||
with the `named` interface. After that, we can use the function with labels
|
||||
(and with no regard for the internal order):
|
||||
@ -201,7 +201,9 @@ eg8 :: "name" :! f [Char]
|
||||
eg8 = record @User
|
||||
|
||||
eg9 :: HKD User Maybe
|
||||
eg9 = eg8 ! #name (Just "Tom") ! #likesDogs (Just True) ! #age (Just 26)
|
||||
eg9 = eg8 ! #name (Just "Tom")
|
||||
! #likesDogs (Just True)
|
||||
! #age (Just 26)
|
||||
```
|
||||
|
||||
If you're _still_ not satisfied, check out the
|
||||
@ -314,7 +316,7 @@ eg18 = label
|
||||
```
|
||||
|
||||
By combining this with some of the
|
||||
[Barbies](http://hackage.haskell.org/package/barbies) interface (the entirety
|
||||
[Barbies](https://hackage.haskell.org/package/barbies) interface (the entirety
|
||||
of which is available to any `HKD`-wrapped type) such as `bprod` and `bmap`, we
|
||||
can implement functions such as `labelsWhere`, which returns the names of all
|
||||
fields whose values satisfy some predicate:
|
||||
|
@ -33,21 +33,17 @@ import Data.Kind (Type)
|
||||
import GHC.Generics
|
||||
import Named ((:!), NamedF (..))
|
||||
|
||||
class Append (xs :: Type -> Type) (ys :: Type -> Type) (zs :: Type -> Type)
|
||||
| xs ys -> zs where
|
||||
type family Append (xs :: Type -> Type) (ys :: Type -> Type) :: Type -> Type where
|
||||
Append (S1 meta head) tail = S1 meta head :*: tail
|
||||
Append (left :*: right) other = left :*: Append right other
|
||||
|
||||
instance Append (S1 m h) t (S1 m h :*: t)
|
||||
instance Append x y z => Append (w :*: x) y (w :*: z)
|
||||
type family Rearrange (i :: Type -> Type) :: Type -> Type where
|
||||
Rearrange (S1 m inner) = S1 m (Rearrange inner)
|
||||
Rearrange (M1 index m inner) = M1 index m (Rearrange inner)
|
||||
Rearrange (left :*: right) = Append (Rearrange left) (Rearrange right)
|
||||
Rearrange (Rec0 inner) = Rec0 inner
|
||||
|
||||
class Rearrange (i :: Type -> Type) (o :: Type -> Type) | i -> o
|
||||
instance Rearrange i o => Rearrange (D1 m i) (D1 m o)
|
||||
instance Rearrange i o => Rearrange (C1 m i) (C1 m o)
|
||||
instance Rearrange i o => Rearrange (S1 m i) (S1 m o)
|
||||
instance Rearrange (Rec0 x) (Rec0 x)
|
||||
instance (Rearrange l l', Rearrange r r', Append l' r' o)
|
||||
=> Rearrange (l :*: r) o where
|
||||
|
||||
-- | The 'Data.Generic.HKD.build' function lets us supply arguments to a type
|
||||
-- | The 'Data.Generic.HKD.record' function lets us supply arguments to a type
|
||||
-- one by one, but can cause confusion when working with a record. If the
|
||||
-- record contains two fields of the same type, for example, we've introduced
|
||||
-- an opportunity for bugs and confusion. The @record@ function uses the
|
||||
@ -57,7 +53,7 @@ instance (Rearrange l l', Rearrange r r', Append l' r' o)
|
||||
--
|
||||
-- >>> :{
|
||||
-- data User
|
||||
-- = User { name :: String, age :: Int, likesDogs :: Bool }
|
||||
-- = User { name :: String, enemy :: String }
|
||||
-- deriving Generic
|
||||
-- :}
|
||||
--
|
||||
@ -68,7 +64,7 @@ instance (Rearrange l l', Rearrange r r', Append l' r' o)
|
||||
-- ...
|
||||
-- ... Found type wildcard ...
|
||||
-- ... standing for ...("name" :! f [Char])
|
||||
-- ... -> ("age" :! f Int) -> ("likesDogs" :! f Bool) -> HKD User f...
|
||||
-- ... -> ("enemy" :! f [Char]) -> HKD User f...
|
||||
-- ...
|
||||
class Record (structure :: Type) (f :: Type -> Type) (k :: Type)
|
||||
| f structure -> k where
|
||||
@ -86,19 +82,28 @@ instance GRecord inner f structure k
|
||||
=> GRecord (C1 meta inner) f structure k where
|
||||
grecord rebuild = grecord (rebuild . M1)
|
||||
|
||||
instance (rec ~ (Rec0 inner), k ~ (name :! inner -> HKD structure f))
|
||||
=> GRecord (S1 ('MetaSel ('Just name) i d c) rec) f structure k where
|
||||
instance
|
||||
( rec ~ (Rec0 inner)
|
||||
, k ~ (name :! inner -> HKD structure f)
|
||||
, meta ~ 'MetaSel ('Just name) i d c
|
||||
)
|
||||
=> GRecord (S1 meta rec) f structure k where
|
||||
grecord fill = \(Arg inner) -> fill (M1 (K1 inner))
|
||||
|
||||
instance (GRecord right f structure k, rec ~ Rec0 x)
|
||||
=> GRecord (S1 ('MetaSel ('Just name) i d c) rec :*: right) f structure (name :! x -> k) where
|
||||
instance
|
||||
( GRecord right f structure k'
|
||||
, rec ~ Rec0 x
|
||||
, left ~ S1 ('MetaSel ('Just name) i d c) rec
|
||||
, k ~ (name :! x -> k')
|
||||
)
|
||||
=> GRecord (left :*: right) f structure k where
|
||||
grecord fill = \(Arg left) -> grecord \right -> fill (M1 (K1 left) :*: right)
|
||||
|
||||
instance
|
||||
( Contravariant (HKD_ f structure)
|
||||
, Functor (HKD_ f structure)
|
||||
|
||||
, Rearrange (HKD_ f structure) list
|
||||
, list ~ Rearrange (HKD_ f structure)
|
||||
, GUpcast list (HKD_ f structure)
|
||||
, GRecord list f structure k
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user