diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +Initial version pushed to hackage. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,97 @@ +# vinyl-generics + +[![Build Status](https://travis-ci.org/VinylRecords/vinyl-generics.png)](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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Vinyl/Generics.hs b/src/Data/Vinyl/Generics.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vinyl/Generics.hs @@ -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 diff --git a/src/Data/Vinyl/Generics/Transform.hs b/src/Data/Vinyl/Generics/Transform.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vinyl/Generics/Transform.hs @@ -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 diff --git a/test/LibSpec.hs b/test/LibSpec.hs new file mode 100644 --- /dev/null +++ b/test/LibSpec.hs @@ -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] ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/vinyl-generics.cabal b/vinyl-generics.cabal new file mode 100644 --- /dev/null +++ b/vinyl-generics.cabal @@ -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