generic-data 0.4.0.0 → 0.5.0.0
raw patch · 7 files changed
+233/−15 lines, 7 filesdep +one-linerdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: one-liner
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Generic.Data.Internal.Microsurgery: type DOnFields (f :: * -> *) (a :: *) = Data (OnFields f (Rep a)) ()
+ Generic.Data.Microsurgery: type DOnFields (f :: * -> *) (a :: *) = Data (OnFields f (Rep a)) ()
- Generic.Data.Internal.Microsurgery: onData :: (UnifyRep (Rep a) (Rep b), UnifyRep (Rep a) (Rep b)) => p a b -> p a b
+ Generic.Data.Internal.Microsurgery: onData :: (UnifyRep r s, UnifyRep s r) => p (Data r x) (Data s y) -> p (Data r x) (Data s y)
- Generic.Data.Internal.Microsurgery: type family SRename' (xs :: [(Symbol, Symbol)]) (f :: *) (s :: Symbol)
+ Generic.Data.Internal.Microsurgery: type family OnFields (f :: * -> *) (r :: k -> *) :: k -> *
- Generic.Data.Microsurgery: onData :: (UnifyRep (Rep a) (Rep b), UnifyRep (Rep a) (Rep b)) => p a b -> p a b
+ Generic.Data.Microsurgery: onData :: (UnifyRep r s, UnifyRep s r) => p (Data r x) (Data s y) -> p (Data r x) (Data s y)
- Generic.Data.Microsurgery: type family (f :: *) @@ (s :: Symbol) :: Symbol
+ Generic.Data.Microsurgery: type family OnFields (f :: * -> *) (r :: k -> *) :: k -> *
Files
- CHANGELOG.md +6/−0
- README.md +18/−4
- generic-data.cabal +15/−1
- src/Generic/Data/Internal/Microsurgery.hs +23/−6
- src/Generic/Data/Microsurgery.hs +21/−2
- test/microsurgery.hs +3/−2
- test/one-liner-surgery.hs +147/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+# 0.5.0.0++- Specialize `onData` to `Data`+- Add some instances for `U1` and `V1` in `Microsurgery`+- Add `OnFields` and `DOnFields` surgeries ("higher-kindification")+ # 0.4.0.0 - Created `Microsurgery` module. Initial set of surgeries:
README.md view
@@ -56,15 +56,29 @@ generic-data offers simple operations on generic representations. More surgeries can be found in-[generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery).+[generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery),+and suprisingly, in+[generic-lens](https://hackage.haskell.org/package/generic-lens) and+[one-liner](https://hackage.haskell.org/package/one-liner). +For more details, see also:++- the module `Generic.Data.Microsurgery`;++- the files `test/lens-surgery.hs` and `one-liner-surgery.hs`.++### Surgery example++Derive an instance of `Show` generically for a record type,+but as if it were not a record.+ ```haskell {-# LANGUAGE DeriveGeneric #-} -import GHC.Generic+import GHC.Generic (Generic) import Generic.Data (gshowsPrec)-import Generic.Data.Microsurgery (unrecordify)+import Generic.Data.Microsurgery (toData, derecordify) newtype T = T { unT :: Int } deriving Generic @@ -78,7 +92,7 @@ -- show (T 3) = "T 3" instance Show T where- showsPrec n = gshowsPrec n . unrecordify . toData+ showsPrec n = gshowsPrec n . derecordify . toData -- This example can be found in test/microsurgery.hs ```
generic-data.cabal view
@@ -1,5 +1,5 @@ name: generic-data-version: 0.4.0.0+version: 0.5.0.0 synopsis: Utilities for GHC.Generics description: This package provides common functions on generic types. See README.@@ -96,6 +96,20 @@ tasty-hunit, generic-data, generic-lens >= 1.1.0.0,+ base+ ghc-options: -Wall+ default-language: Haskell2010+ type: exitcode-stdio-1.0++test-suite one-liner-surgery-test+ hs-source-dirs: test+ main-is: one-liner-surgery.hs+ build-depends:+ tasty,+ tasty-hunit,+ generic-data,+ generic-lens >= 1.1.0.0,+ one-liner >= 1.0, base ghc-options: -Wall default-language: Haskell2010
src/Generic/Data/Internal/Microsurgery.hs view
@@ -113,6 +113,8 @@ type instance RenameFields rnm (f :*: g) = RenameFields rnm f :*: RenameFields rnm g type instance RenameFields rnm (M1 C m f) = M1 C m (RenameFields rnm f) type instance RenameFields rnm (M1 S ('MetaSel ('Just nm) su ss ds) f) = M1 S ('MetaSel ('Just (rnm @@ nm)) su ss ds) f+type instance RenameFields rnm V1 = V1+type instance RenameFields rnm U1 = U1 -- | Rename constructors using the function @rnm@ given as a parameter. --@@ -126,6 +128,7 @@ type instance RenameConstrs rnm (f :+: g) = RenameConstrs rnm f :+: RenameConstrs rnm g type instance RenameConstrs rnm (f :*: g) = RenameConstrs rnm f :*: RenameConstrs rnm g type instance RenameConstrs rnm (M1 C ('MetaCons nm fi ir) f) = M1 C ('MetaCons (rnm @@ nm) fi ir) f+type instance RenameConstrs rnm V1 = V1 -- ** Defining symbol functions @@ -180,16 +183,30 @@ -- | ----- > onData :: _ => (a -> b) -> (a -> b) -- possible specialization+-- > onData :: _ => (Data r x -> Data s y) -> (Data r x -> Data s y) -- possible specialization -- -- Can be used with @generic-lens@ for type-changing field updates with @field_@ -- (and possibly other generic optics). -- -- A specialization of the identity function to be used to fix types--- of functions using 'Data' as input or output, unifying the "spines" of input--- and output generic representations (the "spine" is everything except field--- types, which may thus change).+-- of functions on 'Data', unifying the "spines" of input and output generic+-- representations (the "spine" is everything except field types, which may+-- thus change). onData- :: (UnifyRep (Rep a) (Rep b), UnifyRep (Rep a) (Rep b))- => p a b -> p a b+ :: (UnifyRep r s, UnifyRep s r)+ => p (Data r x) (Data s y) -> p (Data r x) (Data s y) onData = id++-- | Apply a type constructor @f@ to every field type of a generic+-- representation @r@.+type family OnFields (f :: * -> *) (r :: k -> *) :: k -> *+type instance OnFields f (M1 s m r) = M1 s m (OnFields f r)+type instance OnFields f (r :+: s) = OnFields f r :+: OnFields f s+type instance OnFields f (r :*: s) = OnFields f r :*: OnFields f s+type instance OnFields f (K1 i a) = K1 i (f a)+type instance OnFields f U1 = U1+type instance OnFields f V1 = V1++-- | Apply a type constructor to every field type of a type @a@ to make a+-- synthetic type.+type DOnFields (f :: * -> *) (a :: *) = Data (OnFields f (Rep a)) ()
src/Generic/Data/Microsurgery.hs view
@@ -5,8 +5,10 @@ -- -- More complex ones can be found in -- <https://hackage.haskell.org/package/generic-data-surgery generic-data-surgery>--- and, surprisingly, in <https://hackage.haskell.org/package/generic-lens generic-lens>--- (read more about this just below).+-- but also, perhaps surprisingly,+-- in <https://hackage.haskell.org/package/generic-lens generic-lens>+-- (read more about this just below) and+-- <https://hackage.haskell.org/package/one-liner one-liner>. module Generic.Data.Microsurgery ( -- * Surgeries with generic-lens@@ -84,6 +86,23 @@ , SError , SConst , SRename++ -- ** Wrap every field in a type constructor++ -- | Give every field a type @f FieldType@ (where @f@ is a parameter), to+ -- obtain a family of types with a shared structure. This+ -- \"higher-kindification\" technique is presented in the following+ -- blogposts:+ --+ -- - https://www.benjamin.pizza/posts/2017-12-15-functor-functors.html+ -- - https://reasonablypolymorphic.com/blog/higher-kinded-data/+ --+ -- See also the file @test/one-liner-surgery.hs@ in this package for an+ -- example of using one-liner and generic-lens with a synthetic type+ -- constructed with 'DOnFields'.++ , OnFields+ , DOnFields ) where
test/microsurgery.hs view
@@ -5,12 +5,13 @@ -- @DataKinds@ and @TypeApplications@ for @renameFields@ and @renameConstrs@ -import GHC.Generics -- We need to import the constructors for Coercible to resolve+import GHC.Generics (Generic) import Test.Tasty import Test.Tasty.HUnit -import Generic.Data+import Generic.Data (gshowsPrec) import Generic.Data.Microsurgery+ ( toData, derecordify, typeage, renameFields, renameConstrs, SConst, SError, SRename ) -- From https://stackoverflow.com/questions/53864911/derive-positional-show
+ test/one-liner-surgery.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE+ DataKinds,+ DeriveGeneric,+ FlexibleInstances,+ LambdaCase,+ MultiParamTypeClasses,+ ScopedTypeVariables,+ TypeApplications,+ TypeFamilies,+ TypeOperators #-}++{-# OPTIONS_GHC -Wno-name-shadowing #-}++-- Example using one-liner and generic-lens+-- on a synthetic type obtained by surgery.++import Control.Applicative ((<|>))+import Data.Coerce (coerce)+import Data.Functor.Identity (Identity(..))+import GHC.Generics (Generic)+import Text.Read (readMaybe)+import Test.Tasty+import Test.Tasty.HUnit++import Data.Generics.Product (field_) -- generic-lens+import Generics.OneLiner (nullaryOp, binaryOp) -- one-liner+import Generics.OneLiner.Binary (gtraverse)++import Generic.Data.Microsurgery (DOnFields)++-- | Toy configuration record type.+data Config = C {+ a :: Int,+ b :: Int,+ c :: String+ } deriving (Eq, Generic, Show)++-- | Applying the 'DOnFields' surgery to get a type isomorphic to:+--+-- > data Config = C {+-- > a :: Maybe Int,+-- > b :: Maybe Int,+-- > c :: Maybe String+-- > }+--+-- See also "Functor functors" and "Higher-kinded data" for a more general pattern:+--+-- - https://www.benjamin.pizza/posts/2017-12-15-functor-functors.html+-- - https://reasonablypolymorphic.com/blog/higher-kinded-data/+--+type PartialConfig = DOnFields Maybe Config++-- | Example+file1 :: [String]+file1 = [+ "a=11",+ "b=33"+ ]++-- | Example+file2 :: [String]+file2 = [+ "b=2",+ "c=Hello"+ ]++-- | Helper for 'emptyOM' and 'mergeOM' below.+class (a ~ Maybe (UnMaybe a)) => IsMaybe a+instance (a ~ Maybe (UnMaybe a)) => IsMaybe a++-- | Helper for 'IsMaybe' above.+type family UnMaybe (a :: *) :: * where+ UnMaybe (Maybe b) = b++-- |+-- > emptyOM = C {+-- > a = Nothing,+-- > b = Nothing,+-- > c = Nothing+-- > }+emptyOM :: PartialConfig+emptyOM = nullaryOp @IsMaybe Nothing++-- | Helper for 'parseOM' (actually a function from lens).+--+-- @(l .~ b) s@: set the field of record @s@ focused by lens @l@ to @b@.+--+-- > let f = (field_ @"a" .~ v) in+-- > f (C {a = x, b = y, c = z})+-- >+-- > -- equals --+-- >+-- > C {a = v, b = y, c = z}+--+(.~) :: forall s t a b. ((a -> Identity b) -> s -> Identity t) -> b -> s -> t+(.~) l b = coerce l (const b :: a -> b)++-- | Parse lines of a config file.+parseOM :: [String] -> PartialConfig+parseOM = foldr ($) emptyOM . map (\case+ 'a' : '=' : n -> field_ @"a" .~ readMaybe n+ 'b' : '=' : n -> field_ @"b" .~ readMaybe n+ 'c' : '=' : s -> field_ @"c" .~ Just s+ _ -> id)++-- | Merge two records of 'Maybe' fields, keeping the leftmost 'Just' for each+-- field.+mergeOM :: PartialConfig -> PartialConfig -> PartialConfig+mergeOM = binaryOp @IsMaybe (<|>)++-- | Example+parsedOpts12 :: PartialConfig+parsedOpts12 = parseOM file1 `mergeOM` parseOM file2++-- | Helper for 'validateOM' below.+class (a ~ Maybe b) => FstIsMaybe a b+instance (a ~ Maybe b) => FstIsMaybe a b++-- | Check that all fields are populated with 'Just' and create a plain+-- 'Config' record. If any field is 'Nothing', returns 'Nothing'.+validateOM :: PartialConfig -> Maybe Config+validateOM = gtraverse @FstIsMaybe id++-- | Example+opts12 :: Maybe Config+opts12 = validateOM parsedOpts12++main :: IO ()+main = defaultMain test++test :: TestTree+test = testGroup "one-liner-surgery"+ [ testCase "opts1" $+ "C {a = Just 11, b = Just 33, c = Nothing}" @=? show (parseOM file1)++ , testCase "opts2" $+ "C {a = Nothing, b = Just 2, c = Just \"Hello\"}" @=? show (parseOM file2)++ , testCase "opts12" $+ Just C {a = 11, b = 33, c = "Hello"} @=? opts12++ , testCase "opts1-incomplete" $+ Nothing @=? validateOM (parseOM file1)++ , testCase "empty" $+ "C {a = Nothing, b = Nothing, c = Nothing}" @=? show emptyOM+ ]