packages feed

higgledy 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+569/−43 lines, 9 filesdep +nameddep ~QuickCheckdep ~basedep ~hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: named

Dependency ranges changed: QuickCheck, base, hspec

API changes (from Hackage documentation)

- Data.Generic.HKD.Construction: instance (GHC.Base.Functor f, GHC.Generics.Generic structure, Data.Generic.HKD.Construction.GConstruct f (GHC.Generics.Rep structure)) => Data.Generic.HKD.Construction.Construct f structure
+ Data.Generic.HKD: --
+ Data.Generic.HKD: -- </pre>
+ Data.Generic.HKD: -- <a>AllB</a> <a>Show</a> Barbie ~ (<a>Show</a> <a>String</a>, <a>Show</a> <a>Int</a>)
+ Data.Generic.HKD: -- <a>AllBF</a>.
+ Data.Generic.HKD: -- <pre>
+ Data.Generic.HKD: -- For requiring constraints of the form <tt>c (f a)</tt>, use
+ Data.Generic.HKD: -- each <tt>a</tt> occurring under an <tt>f</tt> in <tt>b f</tt>. E.g.:
+ Data.Generic.HKD: -- | <tt><a>AllB</a> c b</tt> should contain a constraint <tt>c a</tt> for
+ Data.Generic.HKD: baddDicts :: (ConstraintsB b, AllB c b) => b f -> b (Product (Dict c) f)
+ Data.Generic.HKD: bdicts :: (ProductBC b, AllB c b) => b (Dict c)
+ Data.Generic.HKD: bmap :: FunctorB b => (forall (a :: k). () => f a -> g a) -> b f -> b g
+ Data.Generic.HKD: btraverse :: (TraversableB b, Applicative t) => (forall (a :: k). () => f a -> t (g a)) -> b f -> t (b g)
+ Data.Generic.HKD: class FunctorB b => ConstraintsB (b :: k -> Type -> Type) where {
+ Data.Generic.HKD: class FunctorB (b :: k -> Type -> Type)
+ Data.Generic.HKD: class (ConstraintsB b, ProductB b) => ProductBC (b :: k -> Type -> Type)
+ Data.Generic.HKD: class FunctorB b => TraversableB (b :: k -> Type -> Type)
+ Data.Generic.HKD: type family AllB (c :: k -> Constraint) (b :: k -> Type -> Type) :: Constraint;
+ Data.Generic.HKD: }
+ Data.Generic.HKD.Construction: instance (GHC.Base.Applicative f, GHC.Generics.Generic structure, Data.Generic.HKD.Construction.GConstruct f (GHC.Generics.Rep structure)) => Data.Generic.HKD.Construction.Construct f structure
+ Data.Generic.HKD.Named: class Record (structure :: Type) (f :: Type -> Type) (k :: Type) | f structure -> k
+ Data.Generic.HKD.Named: instance (Data.Functor.Contravariant.Contravariant (Data.Generic.HKD.Types.HKD_ f structure), GHC.Base.Functor (Data.Generic.HKD.Types.HKD_ f structure), list Data.Type.Equality.~ Data.Generic.HKD.Named.Rearrange (Data.Generic.HKD.Types.HKD_ f structure), Data.Generics.Product.Internal.Subtype.GUpcast list (Data.Generic.HKD.Types.HKD_ f structure), Data.Generic.HKD.Named.GRecord list f structure k) => Data.Generic.HKD.Named.Record structure f k
+ Data.Generic.HKD.Named: instance (Data.Generic.HKD.Named.GRecord right f structure k', rec Data.Type.Equality.~ GHC.Generics.Rec0 x, left Data.Type.Equality.~ GHC.Generics.S1 ('GHC.Generics.MetaSel ('GHC.Maybe.Just name) i d c) rec, k Data.Type.Equality.~ ((name Named.Internal.:! x) -> k')) => Data.Generic.HKD.Named.GRecord (left GHC.Generics.:*: right) f structure k
+ Data.Generic.HKD.Named: instance (rec Data.Type.Equality.~ GHC.Generics.Rec0 inner, k Data.Type.Equality.~ ((name Named.Internal.:! inner) -> Data.Generic.HKD.Types.HKD structure f), meta Data.Type.Equality.~ 'GHC.Generics.MetaSel ('GHC.Maybe.Just name) i d c) => Data.Generic.HKD.Named.GRecord (GHC.Generics.S1 meta rec) f structure k
+ Data.Generic.HKD.Named: instance Data.Generic.HKD.Named.GRecord inner f structure k => Data.Generic.HKD.Named.GRecord (GHC.Generics.C1 meta inner) f structure k
+ Data.Generic.HKD.Named: instance Data.Generic.HKD.Named.GRecord inner f structure k => Data.Generic.HKD.Named.GRecord (GHC.Generics.D1 meta inner) f structure k
+ Data.Generic.HKD.Named: record :: Record structure f k => k

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for partial-structures++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ README.lhs view
@@ -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 ()+```
README.md view
@@ -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 () ```
higgledy.cabal view
@@ -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
src/Data/Generic/HKD.hs view
@@ -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
src/Data/Generic/HKD/Build.hs view
@@ -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,
src/Data/Generic/HKD/Construction.hs view
@@ -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
+ src/Data/Generic/HKD/Named.hs view
@@ -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))
test/Main.hs view
@@ -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 (..))