vinyl-generics-0.1.0.0: test/LibSpec.hs

{-# 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] ]