packages feed

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 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+  ]