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 +5/−0
- README.lhs +339/−0
- README.md +79/−30
- higgledy.cabal +20/−5
- src/Data/Generic/HKD.hs +11/−3
- src/Data/Generic/HKD/Build.hs +3/−3
- src/Data/Generic/HKD/Construction.hs +1/−1
- src/Data/Generic/HKD/Named.hs +111/−0
- test/Main.hs +0/−1
+ 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 (..))