diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for partial-structures + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/README.lhs b/README.lhs new file mode 100644 --- /dev/null +++ b/README.lhs @@ -0,0 +1,339 @@ +# Higgledy 📚 + +Higher-kinded data via generics: all\* the benefits, but none\* of the +boilerplate. + +## Introduction + +When we work with [higher-kinded +data](https://reasonablypolymorphic.com/blog/higher-kinded-data), we find +ourselves writing types like: + +```{haskell, ignore} +data User f + = User + { name :: f String + , age :: f Int + , ... + } +``` + +This is good - we can use `f ~ Maybe` for partial data, `f ~ Identity` for +complete data, etc - but it introduces a fair amount of noise, and we have a +lot of boilerplate deriving to do. Wouldn't it be nice if we could get back to +writing simple types as we know and love them, and get all this stuff for +_free_? + +```{haskell, ignore} +data User + = User + { name :: String + , age :: Int + , ... + } + deriving Generic + +-- HKD for free! +type UserF f = HKD User f +``` + +As an added little bonus, any `HKD`-wrapped object is automatically an instance +of all the [Barbie](https://hackage.haskell.org/package/barbies) classes, so no +need to derive anything more than `Generic`! + +## API + +All examples below were compiled with the following extensions, modules, and +example data types: + +```haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TypeOperators #-} +module Main where + +import Control.Applicative (Alternative (empty)) +import Control.Lens ((.~), (^.), (&), Const (..), Identity, anyOf) +import Data.Barbie (ProductB (buniq)) +import Data.Functor.Const (Const (..)) +import Data.Functor.Identity (Identity (..)) +import Data.Generic.HKD +import Data.Maybe (isJust, isNothing) +import Data.Monoid (Last (..)) +import GHC.Generics (Generic) +import Named ((:!), (!)) + +-- An example of a record (with named fields): +data User + = User + { name :: String + , age :: Int + , likesDogs :: Bool + } + deriving (Generic, Show) + +user :: User +user = User "Tom" 26 True + +-- An example of a product (without named fields): +data Triple + = Triple Int () String + deriving (Generic, Show) + +triple :: Triple +triple = Triple 123 () "ABC" +``` + +### The HKD type constructor + +The `HKD` type takes two parameters: your model type, and the functor in which +we want to wrap all our inputs. By picking different functors for the second +parameter, we can recover various behaviours: + +```haskell +type Partial a = HKD a Last -- Fields may be missing. +type Bare a = HKD a Identity -- All must be present. +type Labels a = HKD a (Const String) -- Every field holds a string. +``` + +_NB: as of GHC 8.8, the `Last` monoid will be removed in favour of `Compose +Maybe Last` (using the `Last` in `Data.Semigroup`). Until then, I'll use `Last` +for brevity, but you may wish to use this suggestion for future-proofing._ + +### Fresh objects + +When we want to start working with the `HKD` interface, we have a couple of +options, depending on the functor in question. The first option is to use +`mempty`: + +```haskell +eg0 :: Partial User +eg0 = mempty +-- User +-- { name = Last {getLast = Nothing} +-- , age = Last {getLast = Nothing} +-- , likesDogs = Last {getLast = Nothing} +-- } +``` + +Other 'Alternative'-style functors lead to very different results: + +```haskell +eg1 :: Labels Triple +eg1 = mempty +-- Triple +-- Const "" +-- Const "" +-- Const "" +``` + +Of course, this method requires every field to be monoidal. If we try with +`Identity`, for example, we're in trouble if all our fields aren't themselves +monoids: + +```{haskell, ignore} +eg2 :: Bare Triple +eg2 = mempty +-- error: +-- • No instance for (Monoid Int) arising from a use of ‘mempty’ +``` + +The other option is to `deconstruct` a complete object. This effectively lifts +a type into the `HKD` structure with `pure` applied to each field: + +```haskell +eg3 :: Bare User +eg3 = deconstruct user +-- User +-- { name = Identity "Tom" +-- , age = Identity 26 +-- , likesDogs = Identity True +-- } +``` + +This approach works with any applicative we like, so we can recover the other +behaviours: + +```haskell +eg4 :: Partial Triple +eg4 = deconstruct @Last triple +-- Triple +-- Last {getLast = Just 123} +-- Last {getLast = Just ()} +-- Last {getLast = Just "ABC"} +``` + +There's also `construct` for when we want to escape our `HKD` wrapper, and +attempt to _construct_ our original type: + +```haskell +eg5 :: Last Triple +eg5 = construct eg4 +-- Last {getLast = Just (Triple 123 () "ABC")} +``` + +If none of the above suit your needs, maybe you want to try `build` on for +size. This function constructs an `HKD`-wrapped version of the type supplied to +it by taking all its parameters. In other words: + +```haskell +eg6 :: f Int -> f () -> f String -> HKD Triple f +eg6 = build @Triple + +eg7 :: HKD Triple [] +eg7 = eg6 [1] [] ["Tom", "Tim"] +-- Triple [1] [] ["Tom","Tim"] +``` + +Should we need to work with records, we can exploit the label trickery of the +[`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): + +```haskell +eg8 :: "name" :! f [Char] + -> "age" :! f Int + -> "likesDogs" :! f Bool + -> HKD User f +eg8 = record @User + +eg9 :: HKD User Maybe +eg9 = eg8 ! #name (Just "Tom") + ! #likesDogs (Just True) + ! #age (Just 26) +``` + +If you're _still_ not satisfied, check out the +[`buniq`](https://hackage.haskell.org/package/barbies-1.1.2.1/docs/Data-Barbie.html#v:buniq) +method hiding in `barbies`: + +```haskell +eg10 :: HKD Triple [] +eg10 = buniq empty +-- Triple [] [] [] +``` + +### Field Access + +The `field` lens, when given a type-applied field name, allows us to focus on +fields within a record: + +```haskell +eg11 :: Last Int +eg11 = eg0 ^. field @"age" +-- Last {getLast = Nothing} +``` + +As this is a true `Lens`, it also means that we can _set_ values within our +record (note that these set values will _also_ need to be in our functor of +choice): + +```haskell +eg12 :: Partial User +eg12 = eg0 & field @"name" .~ pure "Evil Tom" + & field @"likesDogs" .~ pure False +-- User +-- { name = Last {getLast = Just "Evil Tom"} +-- , age = Last {getLast = Nothing} +-- , likesDogs = Last {getLast = Just False} +-- } +``` + +This also means, for example, we can check whether a particular value has been +completed for a given partial type: + +```haskell +eg13 :: Bool +eg13 = anyOf (field @"name") (isJust . getLast) eg0 +-- False +``` + +Finally, thanks to the fact that this library exploits some of the internals of +`generic-lens`, we'll also get a nice type error when we mention a field that +doesn't exist in our type: + +```{haskell, ignore} +eg14 :: Identity () +eg14 = eg3 ^. field @"oops" +-- error: +-- • The type User does not contain a field named 'oops'. +``` + +### Position Access + +Just as with field names, we can use positions when working with non-record +product types: + +```haskell +eg15 :: Labels Triple +eg15 = mempty & position @1 .~ Const "hello" + & position @2 .~ Const "world" +-- Triple +-- Const "hello" +-- Const "world" +-- Const "" +``` + +Again, this is a `Lens`, so we can just as easily _set_ values: + +```haskell +eg16 :: Partial User +eg16 = eg12 & position @2 .~ pure 26 +-- User +-- { name = Last {getLast = Just "Evil Tom"} +-- , age = Last {getLast = Just 26} +-- , likesDogs = Last {getLast = Just False} +-- } +``` + +Similarly, the internals here come to us courtesy of `generic-lens`, so the +type errors are a delight: + +```{haskell, ignore} +eg17 :: Identity () +eg17 = deconstruct @Identity triple ^. position @4 +-- error: +-- • The type Triple does not contain a field at 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` value gives us +this interface: + +```haskell +eg18 :: Labels User +eg18 = label +-- User +-- { name = Const "name" +-- , age = Const "age" +-- , likesDogs = Const "likesDogs" +-- } +``` + +By combining this with some of the +[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: + +```haskell +eg19 :: [String] +eg19 = labelsWhere (isNothing . getLast) eg12 +-- ["age"] +``` + +### Documentation + +All the docs in this library are tested on `cabal new-test`. Furthermore, this +README is tested by `markdown-unlit`. To keep _that_ happy, we do need a `main` +in this file, so just ignore the following :) + +```haskell +main :: IO () +main = pure () +``` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ data](https://reasonablypolymorphic.com/blog/higher-kinded-data), we find ourselves writing types like: -```haskell +```{haskell, ignore} data User f = User { name :: f String @@ -24,7 +24,7 @@ writing simple types as we know and love them, and get all this stuff for _free_? -```haskell +```{haskell, ignore} data User = User { name :: String @@ -38,7 +38,7 @@ ``` 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 @@ -50,15 +50,20 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} -module Example where +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TypeOperators #-} +module Main where +import Control.Applicative (Alternative (empty)) import Control.Lens ((.~), (^.), (&), Const (..), Identity, anyOf) +import Data.Barbie (ProductB (buniq)) import Data.Functor.Const (Const (..)) import Data.Functor.Identity (Identity (..)) import Data.Generic.HKD import Data.Maybe (isJust, isNothing) import Data.Monoid (Last (..)) import GHC.Generics (Generic) +import Named ((:!), (!)) -- An example of a record (with named fields): data User @@ -70,7 +75,7 @@ deriving (Generic, Show) user :: User -user = User "Tom" 25 True +user = User "Tom" 26 True -- An example of a product (without named fields): data Triple @@ -93,6 +98,10 @@ type Labels a = HKD a (Const String) -- Every field holds a string. ``` +_NB: as of GHC 8.8, the `Last` monoid will be removed in favour of `Compose +Maybe Last` (using the `Last` in `Data.Semigroup`). Until then, I'll use `Last` +for brevity, but you may wish to use this suggestion for future-proofing._ + ### Fresh objects When we want to start working with the `HKD` interface, we have a couple of @@ -124,7 +133,7 @@ `Identity`, for example, we're in trouble if all our fields aren't themselves monoids: -```haskell +```{haskell, ignore} eg2 :: Bare Triple eg2 = mempty -- error: @@ -139,7 +148,7 @@ eg3 = deconstruct user -- User -- { name = Identity "Tom" --- , age = Identity 25 +-- , age = Identity 26 -- , likesDogs = Identity True -- } ``` @@ -178,14 +187,43 @@ -- Triple [1] [] ["Tom","Tim"] ``` +Should we need to work with records, we can exploit the label trickery of the +[`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): + +```haskell +eg8 :: "name" :! f [Char] + -> "age" :! f Int + -> "likesDogs" :! f Bool + -> HKD User f +eg8 = record @User + +eg9 :: HKD User Maybe +eg9 = eg8 ! #name (Just "Tom") + ! #likesDogs (Just True) + ! #age (Just 26) +``` + +If you're _still_ not satisfied, check out the +[`buniq`](https://hackage.haskell.org/package/barbies-1.1.2.1/docs/Data-Barbie.html#v:buniq) +method hiding in `barbies`: + +```haskell +eg10 :: HKD Triple [] +eg10 = buniq empty +-- Triple [] [] [] +``` + ### Field Access The `field` lens, when given a type-applied field name, allows us to focus on fields within a record: ```haskell -eg8 :: Last Int -eg8 = eg0 ^. field @"age" +eg11 :: Last Int +eg11 = eg0 ^. field @"age" -- Last {getLast = Nothing} ``` @@ -194,9 +232,9 @@ choice): ```haskell -eg9 :: Partial User -eg9 = eg0 & field @"name" .~ pure "Evil Tom" - & field @"likesDogs" .~ pure False +eg12 :: Partial User +eg12 = eg0 & field @"name" .~ pure "Evil Tom" + & field @"likesDogs" .~ pure False -- User -- { name = Last {getLast = Just "Evil Tom"} -- , age = Last {getLast = Nothing} @@ -208,8 +246,8 @@ completed for a given partial type: ```haskell -eg10 :: Bool -eg10 = anyOf (field @"name") (isJust . getLast) eg0 +eg13 :: Bool +eg13 = anyOf (field @"name") (isJust . getLast) eg0 -- False ``` @@ -217,9 +255,9 @@ `generic-lens`, we'll also get a nice type error when we mention a field that doesn't exist in our type: -```haskell -eg11 :: Identity () -eg11 = eg3 ^. field @"oops" +```{haskell, ignore} +eg14 :: Identity () +eg14 = eg3 ^. field @"oops" -- error: -- • The type User does not contain a field named 'oops'. ``` @@ -230,8 +268,8 @@ product types: ```haskell -eg12 :: Labels Triple -eg12 = mempty & position @1 .~ Const "hello" +eg15 :: Labels Triple +eg15 = mempty & position @1 .~ Const "hello" & position @2 .~ Const "world" -- Triple -- Const "hello" @@ -242,11 +280,11 @@ Again, this is a `Lens`, so we can just as easily _set_ values: ```haskell -eg13 :: Partial User -eg13 = eg9 & position @2 .~ pure 25 +eg16 :: Partial User +eg16 = eg12 & position @2 .~ pure 26 -- User -- { name = Last {getLast = Just "Evil Tom"} --- , age = Last {getLast = Just 25} +-- , age = Last {getLast = Just 26} -- , likesDogs = Last {getLast = Just False} -- } ``` @@ -254,9 +292,9 @@ Similarly, the internals here come to us courtesy of `generic-lens`, so the type errors are a delight: -```haskell -eg14 :: Identity () -eg14 = deconstruct @Identity triple ^. position @4 +```{haskell, ignore} +eg17 :: Identity () +eg17 = deconstruct @Identity triple ^. position @4 -- error: -- • The type Triple does not contain a field at position 4 ``` @@ -268,8 +306,8 @@ this interface: ```haskell -eg15 :: Labels User -eg15 = label +eg18 :: Labels User +eg18 = label -- User -- { name = Const "name" -- , age = Const "age" @@ -278,13 +316,24 @@ ``` 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: ```haskell -eg16 :: [String] -eg16 = labelsWhere (isNothing . getLast) eg9 +eg19 :: [String] +eg19 = labelsWhere (isNothing . getLast) eg12 -- ["age"] +``` + +### Documentation + +All the docs in this library are tested on `cabal new-test`. Furthermore, this +README is tested by `markdown-unlit`. To keep _that_ happy, we do need a `main` +in this file, so just ignore the following :) + +```haskell +main :: IO () +main = pure () ``` diff --git a/higgledy.cabal b/higgledy.cabal --- a/higgledy.cabal +++ b/higgledy.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: higgledy -version: 0.3.0.0 +version: 0.3.1.0 synopsis: Partial types as a type constructor. description: Use the generic representation of an ADT to get a higher-kinded data-style interface automatically. homepage: https://github.com/i-am-tom/higgledy @@ -12,20 +12,23 @@ maintainer: tom.harding@habito.com -- copyright: category: Data -extra-source-files: README.md +extra-source-files: CHANGELOG.md + , README.md library exposed-modules: Data.Generic.HKD Data.Generic.HKD.Build Data.Generic.HKD.Construction Data.Generic.HKD.Labels + Data.Generic.HKD.Named Data.Generic.HKD.Types -- other-modules: -- other-extensions: build-depends: base ^>= 4.12 , barbies ^>= 1.1.0 , generic-lens ^>= 1.1.0 - , QuickCheck ^>= 2.12.6 + , QuickCheck >= 2.12.6 && < 2.14 + , named ^>= 0.3.0.0 hs-source-dirs: src default-language: Haskell2010 @@ -34,10 +37,22 @@ , barbies ^>= 1.1.0 , doctest ^>= 0.16.0 , higgledy - , hspec ^>= 2.6.1 + , hspec >= 2.6.1 && < 2.8 , lens ^>= 4.17 - , QuickCheck ^>= 2.12.6 + , QuickCheck >= 2.12.6 && < 2.14 main-is: Main.hs type: exitcode-stdio-1.0 hs-source-dirs: test default-language: Haskell2010 + +test-suite readme + build-depends: base + , barbies ^>= 1.1.0 + , lens ^>= 4.17 + , higgledy + , named ^>= 0.3.0.0 + main-is: README.lhs + type: exitcode-stdio-1.0 + default-language: Haskell2010 + ghc-options: -pgmL markdown-unlit -Wall + build-tool-depends: markdown-unlit:markdown-unlit diff --git a/src/Data/Generic/HKD.hs b/src/Data/Generic/HKD.hs --- a/src/Data/Generic/HKD.hs +++ b/src/Data/Generic/HKD.hs @@ -15,6 +15,11 @@ module Data.Generic.HKD ( module Exports + , Barbie.ConstraintsB (..) + , Barbie.FunctorB (..) + , Barbie.ProductBC (..) + , Barbie.TraversableB (..) + , position , field ) where @@ -22,8 +27,11 @@ import Data.Generic.HKD.Build as Exports import Data.Generic.HKD.Construction as Exports import Data.Generic.HKD.Labels as Exports +import Data.Generic.HKD.Named as Exports import Data.Generic.HKD.Types as Exports +import qualified Data.Barbie as Barbie + import qualified Data.Generics.Internal.VL.Lens as G import qualified Data.Generics.Product as G @@ -57,7 +65,7 @@ -- >>> total & field @"oops" .~ pure () -- ... -- ... error: --- ... • The type HKD User Last does not contain a field named 'oops'. +-- ... The type HKD User Last does not contain a field named 'oops'. -- ... field :: forall field f structure inner @@ -83,8 +91,8 @@ -- >>> deconstruct ("Hello", True) ^. position @4 -- ... -- ... error: --- ... • The type HKD --- ... ([Char], Bool) f does not contain a field at position 4 +-- ... The type HKD +-- ... ([Char], Bool) f does not contain a field at position 4 -- ... position :: forall index f structure inner diff --git a/src/Data/Generic/HKD/Build.hs b/src/Data/Generic/HKD/Build.hs --- a/src/Data/Generic/HKD/Build.hs +++ b/src/Data/Generic/HKD/Build.hs @@ -75,14 +75,14 @@ -- = User { name :: String, age :: Int, likesDogs :: Bool } -- deriving Generic -- :} --- +-- -- >>> :{ -- test :: _ -- test = build @User -- :} -- ... --- ... • Found type wildcard ‘_’ --- ... standing for ‘f [Char] -> f Int -> f Bool -> HKD User f’ +-- ... Found type wildcard ... +-- ... standing for ...f [Char] -> f Int -> f Bool -> HKD User f... -- ... -- -- Once we call the 'build' function, and indicate the type we want to build, diff --git a/src/Data/Generic/HKD/Construction.hs b/src/Data/Generic/HKD/Construction.hs --- a/src/Data/Generic/HKD/Construction.hs +++ b/src/Data/Generic/HKD/Construction.hs @@ -74,7 +74,7 @@ gconstruct (K1 x) = fmap K1 x gdeconstruct (K1 x) = K1 (pure x) -instance (Functor f, Generic structure, GConstruct f (Rep structure)) +instance (Applicative f, Generic structure, GConstruct f (Rep structure)) => Construct f structure where construct = fmap to . gconstruct . runHKD deconstruct = HKD . gdeconstruct @f . from diff --git a/src/Data/Generic/HKD/Named.hs b/src/Data/Generic/HKD/Named.hs new file mode 100644 --- /dev/null +++ b/src/Data/Generic/HKD/Named.hs @@ -0,0 +1,111 @@ +{-# OPTIONS_HADDOCK not-home #-} + +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-| +Module : Data.Generic.HKD.Named +Description : Construct an HKD record with named parameters. +Copyright : (c) Tom Harding, 2019 +License : MIT +Maintainer : tom.harding@habito.com +Stability : experimental +-} +module Data.Generic.HKD.Named + ( Record (..) + ) where + +import Data.Functor.Contravariant (Contravariant (..)) +import Data.Generic.HKD.Types (HKD, HKD_) +import Data.GenericLens.Internal (GUpcast (..)) +import Data.Kind (Type) +import GHC.Generics +import Named ((:!), NamedF (..)) + +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 + +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 + +-- | 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 +-- wonderful @named@ package to help us: +-- +-- >>> :set -XDeriveGeneric -XTypeApplications +-- +-- >>> :{ +-- data User +-- = User { name :: String, enemy :: String } +-- deriving Generic +-- :} +-- +-- >>> :{ +-- test :: _ +-- test = record @User +-- :} +-- ... +-- ... Found type wildcard ... +-- ... standing for ...("name" :! f [Char]) +-- ... -> ("enemy" :! f [Char]) -> HKD User f... +-- ... +class Record (structure :: Type) (f :: Type -> Type) (k :: Type) + | f structure -> k where + record :: k + +class GRecord (rep :: Type -> Type) (f :: Type -> Type) (structure :: Type) (k :: Type) + | f structure rep -> k where + grecord :: (forall p. rep p -> HKD structure f) -> k + +instance GRecord inner f structure k + => GRecord (D1 meta inner) f structure k where + grecord rebuild = grecord (rebuild . M1) + +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) + , 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 + , 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) + + , list ~ Rearrange (HKD_ f structure) + , GUpcast list (HKD_ f structure) + , GRecord list f structure k + ) + => Record structure f k where + record = grecord @_ @f @structure (to . gupcast @list @(HKD_ f structure)) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -11,7 +11,6 @@ module Main where import Control.Lens (Lens', (.~), (^.)) -import Data.Barbie import Data.Barbie.Constraints (Dict) import Data.Function ((&), on) import Data.Functor.Identity (Identity (..))