vinyl-generics (empty) → 0.1.0.0
raw patch · 9 files changed
+488/−0 lines, 9 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, generics-sop, hspec, hspec-core, records-sop, text, vinyl, vinyl-generics
Files
- CHANGELOG.md +3/−0
- LICENSE +20/−0
- README.md +97/−0
- Setup.hs +2/−0
- src/Data/Vinyl/Generics.hs +15/−0
- src/Data/Vinyl/Generics/Transform.hs +114/−0
- test/LibSpec.hs +188/−0
- test/Spec.hs +1/−0
- vinyl-generics.cabal +48/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++Initial version pushed to hackage.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright Author name here (c) 2018++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,97 @@+# vinyl-generics++[](https://travis-ci.org/VinylRecords/vinyl-generics)++Convert plain Haskell records to [vinyl](https://hackage.haskell.org/package/vinyl) and vice versa, via `GHC.Generics` and `generics-sop`/`records-sop`.++## Potential Use Cases+* Reading an external data source (database query, results of API requests etc.) as a list of plain Haskell records and converting it to a list of `vinyl` records (for subsequent conversion to an in-memory [data-frame](https://hackage.haskell.org/package/Frames)).+* Serializing a `Frame`/list of `vinyl` records to JSON.+* Adding/removing fields from a plain record using `vinyl` as an intermediate representation.++## Usage+Consider the following example module: ++```haskell +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module Example where++import Data.Aeson+import Data.Text+import Data.Vinyl+import Data.Vinyl.Generics.Transform (fromVinyl, toVinyl)+import qualified Generics.SOP as S+import qualified GHC.Generics as G++data MyPlainRecord = MPR {+ age :: Int,+ iscool :: Bool,+ yearbook :: Text+} deriving (Show, G.Generic)++instance S.Generic MyPlainRecord+instance S.HasDatatypeInfo MyPlainRecord++data MyType = + MyType { + bike :: Bool+ , skateboard :: Bool + } deriving (Show, G.Generic)++data MyPlainRecord2 = MPR2 {+ age :: Int,+ iscool :: Bool,+ yearbook :: Text,+ hobbies :: MyType+} deriving (Show, G.Generic)++instance S.Generic MyPlainRecord2+instance S.HasDatatypeInfo MyPlainRecord2++```++In the above, let `MyPlainRecord` be the format in which data is being read from an external source. We also read some additional data `additionalFields` (say from a CSV using `Frames`): ++```haskell+-- some mock data+r1 :: MyPlainRecord+r1 = MPR { age = 23, iscool = True, yearbook = "!123!"}++additionalFields :: Rec ElField '[("age" ::: Int), ("hobbies" ::: MyType)]+additionalFields = xrec (23, MyType { bike = True, skateboard = True})+```+++We'd like to add the field `hobbies :: MyType` to one such record (` :: MyPlainRecord`), and want to have a record of type `MyPlainRecord2`. We can accomplish this by first isolating the field:+```haskell+getHobbies :: Rec ElField '[("age" ::: Int), ("hobbies" ::: MyType)] + -> Rec ElField '[("hobbies" ::: MyType)]+getHobbies = rcast+```++...and then appending it to the `vinyl` representation of the plain record:++```haskell+go :: MyPlainRecord2+go = fromVinyl $ (toVinyl r1) `rappend` (getHobbies additionalFields)+```++That's all there is to it. Once we have our vinyl record in plain record form, it is straightforward to serialize it to JSON: ++```haskell+instance ToJSON MyPlainRecord2+instance ToJSON MyType+```++Have a look at `test/LibSpec.hs` for more usage examples.++## Known Limitations+This library, in its current form, works only with `vinyl` records with type-level field names (i.e. use the `ElField` interpretation functor).+Future versions hope to tackle records with anonymous fields (e.g. heterogenous lists making use of the `Identity` functor) as well.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Vinyl/Generics.hs view
@@ -0,0 +1,15 @@+{-|+Module : Data.Vinyl.Generics+Description : Re-exports the underlying module.+Copyright : (c) Gagandeep Bhatia, 2019+License : BSD3+Stability : experimental++This library provides a way to convert a plain Haskell record to a @vinyl@ record, and vice versa.++-}+module Data.Vinyl.Generics (+ module Data.Vinyl.Generics.Transform+) where++import Data.Vinyl.Generics.Transform
+ src/Data/Vinyl/Generics/Transform.hs view
@@ -0,0 +1,114 @@+-- | Generic functions to convert plain Haskell records+-- to their @vinyl@ representation and back.+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Vinyl.Generics.Transform(+ toVinyl+ , fromVinyl+) where++import Data.Vinyl+import Generics.SOP+import Generics.SOP.NP+import qualified Generics.SOP.Record as SR+import GHC.TypeLits++-- | This typeclass provides a method to change the+-- interpretation functor of a particular @vinyl@ record+-- from @P@ to @ElField@.+class NatTrans rs where+ rmap' :: Rec SR.P rs -> Rec ElField rs++instance NatTrans '[] where+ rmap' RNil = RNil++instance (NatTrans xs, x ~ '(s, t), KnownSymbol s) => NatTrans (x ': xs) where+ rmap' ((SR.P x) :& xs) = (Field x) :& rmap' xs++-- | This typeclass constrains that given a type-level list of field-name,+-- field-type tuples (i.e. @rs@), it is possible to "fold" in general sense+-- (i.e. a "catamorphism") over a @vinyl@ record parameterised by @rs@,+-- swap all it's constructors with those from @NP@ (N-ary product from+-- @generics-sop@) and discard the field names by using the @I@+-- interpretation functor from @generics-sop@ and yield something+-- of type @NP I ys@.+class Cata rs ys | rs -> ys where+ recToNP :: Rec ElField rs -> NP I ys++instance Cata '[] '[] where+ recToNP RNil = Nil++instance (Cata xs ys, y ~ SR.Snd x) => Cata (x ': xs) (y ': ys) where+ recToNP ((Field x) :& xs) = (I x) :* recToNP xs++-- | Given a plain record, returns the @vinyl@ equivalent with the+-- field names as type-level strings, tupled with the field type.+--+-- Example:+--+-- @+-- import qualified Generics.SOP as S+-- import qualified GHC.Generics as G+--+-- data MyPlainRecord = MPR {+-- age :: Int,+-- iscool :: Bool,+-- yearbook :: Text+-- } deriving (Show, G.Generic)+--+-- instance S.Generic MyPlainRecord+-- instance S.HasDatatypeInfo MyPlainRecord+-- -- Note: requires all 3 instances: G.Generic, S.Generic and S.HasDatatypeInfo+--+-- -- this now works! Type signature is optional here.+-- convertToVinyl :: MyPlainRecord+-- -> Rec ElField '[("age" ::: Int), ("iscool" ::: Bool), ("yearbook" ::: Text)]+-- convertToVinyl = toVinyl+-- @+--+toVinyl :: (SR.IsRecord a rs, NatTrans rs) => a -> Rec ElField rs+toVinyl r = rmap' (cata_NP RNil (:&) np)+ where+ np = SR.toRecord r++-- | Given a @vinyl@ record, returns the plain record equivalent.+-- Requires the equivalent plain record data declaration to be available+-- in current scope.+--+-- Additionally, it requires explicit type annotation (either using a+-- type signature or using @TypeApplications@).+--+-- Example:+--+-- @+-- import qualified Generics.SOP as S+-- import qualified GHC.Generics as G+--+-- r1 :: Rec ElField '[("age" ::: Int), ("iscool" ::: Bool), ("yearbook" ::: Text)]+-- r1 = xrec (23, True, "!123!")+--+-- data MyPlainRecord = MPR {+-- age :: Int,+-- iscool :: Bool,+-- yearbook :: Text+-- } deriving (Show, G.Generic)+--+-- instance S.Generic MyPlainRecord+-- -- Note: Here we need only G.Generic and S.Generic+--+-- -- Using explicit type signature+-- r2 :: MyPlainRecord+-- r2 = fromVinyl r1+--+-- -- or using TypeApplications+-- r2' = fromVinyl @MyPlainRecord r1+-- @+--+fromVinyl :: (Generic a, Code a ~ ts, ts ~ '[ys], Cata rs ys)+ => Rec ElField rs+ -> a+fromVinyl = to . SOP . Z . recToNP
+ test/LibSpec.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module LibSpec where++import Data.Aeson+import Data.Text+import Data.Vinyl+import Data.Vinyl.Generics.Transform+import qualified Generics.SOP as S+import qualified GHC.Generics as G+import Test.Hspec++data MyPlainRecord = MPR {+ age :: Int,+ iscool :: Bool,+ yearbook :: Text+} deriving (Show, G.Generic)++instance S.Generic MyPlainRecord+instance S.HasDatatypeInfo MyPlainRecord+instance ToJSON MyPlainRecord++data MyType = MyType { bike :: Bool, skateboard :: Bool } deriving (Show, G.Generic)+instance ToJSON MyType++data MyPlainRecord2 = MPR2 {+ age :: Int,+ iscool :: Bool,+ yearbook :: Text,+ hobbies :: MyType+} deriving (Show, G.Generic)++instance S.Generic MyPlainRecord2+instance S.HasDatatypeInfo MyPlainRecord2+instance ToJSON MyPlainRecord2++data MySubsetRecord = MSR {+ age :: Int,+ yearbook :: Text+} deriving (Eq, Show, G.Generic)++instance S.Generic MySubsetRecord++data CartUsers = CartUsers {+ _Email :: Text,+ _First_name :: Text,+ _Last_name :: Text,+ _Is_member :: Bool,+ _Days_in_queue :: Int+} deriving (G.Generic)++deriving instance Show CartUsers+instance S.Generic CartUsers+instance S.HasDatatypeInfo CartUsers+++data SubsetUsers = SubsetCartUsers {+ _Email :: Text,+ _First_name :: Text,+ _Last_name :: Text+} deriving (G.Generic)++instance S.Generic SubsetUsers+instance S.HasDatatypeInfo SubsetUsers+deriving instance Show SubsetUsers+deriving instance Eq SubsetUsers++data SupersetUsers = SupersetCartUsers {+ _Email :: Text,+ _First_name :: Text,+ _Last_name :: Text,+ _Is_member :: Bool,+ _Days_in_queue :: Int,+ _Zipcode :: Text,+ _City :: Text,+ _Country :: Text+} deriving (G.Generic)++deriving instance Show SupersetUsers+instance S.Generic SupersetUsers+instance S.HasDatatypeInfo SupersetUsers+deriving instance Eq SupersetUsers++main :: IO ()+main =+ hspec spec++spec :: Spec+spec =+ describe "Lib" $ do+ it "test1: Converting a plain record to vinyl" $ do+ (toVinyl r1) `shouldBe` r2+ it "test2: Subsetting a plain record" $ do+ (fromVinyl $ subset (toVinyl r1)) `shouldBe` r3+ it "test3: Subsetting a larger plain record" $ do+ (+ fromVinyl+ . rcast @[("_Email" ::: Text),("_First_name" ::: Text), ("_Last_name" ::: Text)]+ . toVinyl $ r4) `shouldBe` r5+ it "test4: Adding fields to a plain record" $ do+ r6 `shouldBe` r7+ it "test5: JSON encoding" $ do+ (toJSON $ fromVinyl @MyPlainRecord r1') `shouldBe` r1JSON+ it "test6: JSON encoding nested records" $ do+ (toJSON $ fromVinyl @MyPlainRecord2 r3') `shouldBe` r3JSON+++r1 :: MyPlainRecord+r1 = MPR { age = 23, iscool = True, yearbook = "!123!"}++subset ::+ Rec ElField '[("age" ::: Int), ("iscool" ::: Bool), ("yearbook" ::: Text)]+ -> Rec ElField '[("age" ::: Int), ("yearbook" ::: Text)]+subset = rcast+++r2 :: Rec ElField '[("age" ::: Int), ("iscool" ::: Bool), ("yearbook" ::: Text)]+r2 = xrec (23, True, "!123!")++r3 :: MySubsetRecord+r3 = MSR {age = 23, yearbook = "!123!"}++r4 :: CartUsers+r4 =+ CartUsers {+ _Email = "johndoe@foobar.com"+ , _First_name = "John"+ , _Last_name = "Doe"+ , _Is_member = True+ , _Days_in_queue = 42+ }++r5 :: SubsetUsers+r5 =+ SubsetCartUsers {+ _Email = "johndoe@foobar.com"+ , _First_name = "John"+ , _Last_name = "Doe"+ }++additionalFields :: Rec ElField '[("_Zipcode" ::: Text), ("_City" ::: Text), ("_Country" ::: Text)]+additionalFields = xrec ("ABCD1234", "ABC", "XYZ")++r6 :: SupersetUsers+r6 = fromVinyl $ (toVinyl r4) `rappend` additionalFields++r7 :: SupersetUsers+r7 =+ SupersetCartUsers {+ _Email = "johndoe@foobar.com"+ , _First_name = "John"+ , _Last_name = "Doe"+ , _Is_member = True+ , _Days_in_queue = 42+ , _Zipcode = "ABCD1234"+ , _City = "ABC"+ , _Country = "XYZ"+ }+++++-- * JSON Encoding Test Cases++r1' :: Rec ElField '[("age" ::: Int), ("iscool" ::: Bool), ("yearbook" ::: Text)]+r1' = xrec (23, True, "You spin me right round")++r1JSON :: Value+r1JSON = object [ "age" .= (23 :: Int)+ , "iscool" .= True+ , "yearbook" .= ("You spin me right round" :: Text) ]++r3' :: Rec ElField '[ "age" ::: Int+ , "iscool" ::: Bool+ , "yearbook" ::: Text+ , "hobbies" ::: MyType ]+r3' = xrec (23, True, "You spin me right round", MyType True True)++r3JSON :: Value+r3JSON = object [ "age" .= (23 :: Int)+ , "iscool" .= True+ , "yearbook" .= ("You spin me right round" :: Text)+ , "hobbies" .= object ["bike" .= True, "skateboard" .= True] ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ vinyl-generics.cabal view
@@ -0,0 +1,48 @@+name: vinyl-generics+version: 0.1.0.0+synopsis: Convert plain records to vinyl (and vice versa), generically.+description: + Convert plain records to @vinyl@ and vice versa, via @GHC.Generics@ and @generics-sop@/@records-sop@.+homepage: https://github.com/VinylRecords/vinyl-generics+license: BSD3+license-file: LICENSE+author: Gagandeep Bhatia+maintainer: gagandeepbhatia.in@gmail.com+copyright: 2018 Gagandeep Bhatia+category: Data, Generics+build-type: Simple+extra-source-files: README.md CHANGELOG.md+cabal-version: >=1.10++library+ default-language: Haskell2010+ ghc-options: -Wall + hs-source-dirs: src+ exposed-modules: Data.Vinyl.Generics+ , Data.Vinyl.Generics.Transform+ build-depends: base >= 4.7 && < 5+ , generics-sop >= 0.3.2+ , vinyl >= 0.10+ , records-sop >= 0.1.0.2++test-suite spec+ default-language: Haskell2010+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: LibSpec+ build-depends: base+ , vinyl-generics+ , hspec+ , hspec-core >=2.4.8+ , QuickCheck+ , generics-sop + , text+ , vinyl+ , records-sop+ , aeson++source-repository head+ type: git+ location: https://github.com/VinylRecords/vinyl-generics