superrecord (empty) → 0.1.0.0
raw patch · 7 files changed
+670/−0 lines, 7 filesdep +aesondep +basedep +bookkeepersetup-changed
Dependencies added: aeson, base, bookkeeper, constraints, criterion, deepseq, ghc-prim, hspec, labels, primitive, superrecord, text
Files
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- bench/Bench.hs +130/−0
- src/SuperRecord.hs +385/−0
- superrecord.cabal +55/−0
- test/Spec.hs +63/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexander Thiemann (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexander Thiemann nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# SuperRecord++[](https://circleci.com/gh/agrafix/superrecord)++Supercharged anonymous records
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+import Criterion+import Criterion.Main++import Control.DeepSeq+import Data.Aeson+import GHC.Generics+import SuperRecord+import qualified Bookkeeper as B+import qualified Labels as L++data Nested+ = Nested+ { n_f41 :: String+ } deriving (Generic)++instance NFData Nested+instance ToJSON Nested+instance FromJSON Nested++data Native+ = Native+ { n_f1 :: String+ , n_f2 :: Int+ , n_f3 :: Bool+ , n_f4 :: Nested+ } deriving (Generic)++instance NFData Native+instance ToJSON Native+instance FromJSON Native++type Ex1 =+ '[ "f1" := String+ , "f2" := Int+ , "f3" := Bool+ , "f4" := Rec '[ "f41" := String ]+ ]++r1 :: Rec Ex1+r1 =+ #f1 := "Hi"+ & #f2 := 213+ & #f3 := True+ & #f4 := (#f41 := "abc" & rnil)+ & rnil++r1L ::+ ( "f1" L.:= String+ , "f2" L.:= Int+ , "f3" L.:= Bool+ , "f4" L.:= ("f41" L.:= String)+ )+r1L =+ ( #f1 L.:= "Hi"+ , #f2 L.:= 213+ , #f3 L.:= True+ , #f4 L.:= (#f41 L.:= "abc")+ )++r1B ::+ B.Book+ '[ "f1" B.:=> String+ , "f2" B.:=> Int+ , "f3" B.:=> Bool+ , "f4" B.:=> B.Book '[ "f41" B.:=> String ]+ ]+r1B =+ B.emptyBook+ B.& #f1 B.=: "Hi"+ B.& #f2 B.=: 213+ B.& #f3 B.=: True+ B.& #f4 B.=: (B.emptyBook B.& #f41 B.=: "abc")++r1N =+ Native+ { n_f1 = "Hi"+ , n_f2 = 213+ , n_f3 = True+ , n_f4 = Nested "abc"+ }++main :: IO ()+main =+ defaultMain+ [ bgroup "get"+ [ bench "superrecord" $ nf (get #f2) r1+ , bench "labels" $ nf (L.get #f2) r1L+ , bench "bookkeeper" $ nf (\r -> r B.?: #f2) r1B+ , bench "native" $ nf n_f2 r1N+ ]+ , bgroup "get nested"+ [ bench "superrecord" $ nf (get #f41 . get #f4) r1+ , bench "labels" $ nf (L.get #f41 . L.get #f4) r1L+ , bench "bookkeeper" $ nf (\r -> r B.?: #f4 B.?: #f41) r1B+ , bench "native" $ nf (n_f41 . n_f4) r1N+ ]+ , bgroup "set nested"+ [ bench "superrecord" $+ nf (\r -> (setPath (#f4 &: #f41 &: snil) "Hello" r) &. #f4 &. #f41) r1+ , bench "labels" $+ nf (\r -> L.get #f41 . L.get #f4 $ L.modify #f4 (L.set #f41 "Hello") r) r1L+ , bench "bookkeeper" $+ nf (\r -> (r B.& #f4 B.%: (\s -> s B.& #f41 B.%: const "Hello")) B.?: #f4 B.?: #f41) r1B+ , bench "native" $+ nf (\r -> n_f41 $ n_f4 (r { n_f4 = (n_f4 r) { n_f41 = "Hello" } })) r1N+ ]+ , bgroup "set get"+ [ bench "superrecord" $ nf (get #f2 . set #f2 123) r1+ , bench "labels" $ nf (L.get #f2 . L.set #f2 123) r1L+ , bench "bookkeeper" $ nf (\r -> (r B.& #f2 B.%: const (123 :: Int)) B.?: #f2) r1B+ , bench "native" $ nf (\r -> n_f2 (r { n_f2 = 123 })) r1N+ ]+ , bgroup "set rec"+ [ bench "superrecord" $ nf (set #f2 123) r1+ , bench "native" $ nf (\r -> r { n_f2 = 123 }) r1N+ ]+ , bgroup "json"+ [ bench "superrecord" $ nf @[Rec Ex1] (throwOnNone . decode' . encode) $ replicate 50 r1+ , bench "native" $ nf @[Native] (throwOnNone . decode' . encode) $ replicate 50 r1N+ ]+ ]++throwOnNone :: Maybe a -> a+throwOnNone (Just x) = x+throwOnNone _ = error "What?!"
+ src/SuperRecord.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE MagicHash #-}+module SuperRecord+ ( -- * Basics+ (:=)(..)+ , Rec, rnil, rcons, (&)+ , Has+ , get, (&.)+ , set, SetPath(..), SPath(..), (&:), snil+ -- * Reflection+ , reflectRec, RecApply(..)+ -- * Machinery+ , RecTyIdxH, RecIdxTyH+ , showRec, RecKeys(..)+ , RecEq(..)+ , recToValue, recToEncoding+ , recJsonParser, RecJsonParse(..)+ , RecNfData(..)+ , RecSize, RemoveAccessTo+ , FldProxy(..), RecDeepTy+ )+where++import Control.DeepSeq+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Constraint+import Data.Proxy+import Data.Typeable+import GHC.OverloadedLabels+import GHC.Prim+import GHC.TypeLits+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.Primitive.Array as A+import qualified Data.Text as T++-- | Field named @l@ labels value of type @t@ adapted from the awesome /labels/ package.+-- Example: @(#name := \"Chris\") :: (\"name\" := String)@+data label := value = KnownSymbol label => FldProxy label := !value+deriving instance Typeable (:=)+deriving instance Typeable (label := value)+infix 6 :=++instance (Eq value) => Eq (label := value) where+ (_ := x) == (_ := y) = x == y+ {-# INLINE (==) #-}++instance (Ord value) => Ord (label := value) where+ compare (_ := x) (_ := y) = x `compare` y+ {-# INLINE compare #-}++instance (Show t) =>+ Show (l := t) where+ showsPrec p (l := t) =+ showParen (p > 10) (showString ("#" ++ symbolVal l ++ " := " ++ show t))++-- | A proxy witness for a label. Very similar to 'Proxy', but needed to implement+-- a non-orphan 'IsLabel' instance+data FldProxy (t :: Symbol)+ = FldProxy+ deriving (Show, Read, Eq, Ord, Typeable)++instance l ~ l' => IsLabel (l :: Symbol) (FldProxy l') where+ fromLabel _ = FldProxy++-- | The core record type.+newtype Rec (lts :: [*])+ = Rec { _unRec :: (A.Array Any) }++instance (RecApply lts lts Show) => Show (Rec lts) where+ show = show . showRec++instance RecEq lts lts => Eq (Rec lts) where+ (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)+ {-# INLINE (==) #-}++instance+ ( RecApply lts lts ToJSON+ ) => ToJSON (Rec lts) where+ toJSON = recToValue+ toEncoding = recToEncoding++instance (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => FromJSON (Rec lts) where+ parseJSON = recJsonParser++instance RecNfData lts lts => NFData (Rec lts) where+ rnf = recNfData (Proxy :: Proxy lts)++-- | An empty record+rnil :: Rec '[]+rnil = unsafeRnil 0+{-# INLINE rnil #-}++-- | An empty record with an initial size for the record+unsafeRnil :: Int -> Rec '[]+unsafeRnil initSize =+ Rec $ unsafePerformIO (A.newArray initSize (error "No Value") >>= A.unsafeFreezeArray)+{-# INLINE unsafeRnil #-}++-- | Prepend a record entry to a record 'Rec'+rcons :: forall l t lts s. (RecSize lts ~ s, KnownNat s) => l := t -> Rec lts -> Rec (l := t ': lts)+rcons (_ := val) (Rec vec) =+ Rec $+ unsafePerformIO $!+ do m2 <- A.newArray (size + 1) (error "No Value")+ A.copyArray m2 0 vec 0 size+ A.writeArray m2 size (unsafeCoerce# val)+ A.unsafeFreezeArray m2+ where+ size = fromIntegral $ natVal' (proxy# :: Proxy# s)+{-# INLINE rcons #-}++-- | Prepend a record entry to a record 'Rec'. Assumes that the record was created with+-- 'unsafeRnil' and still has enough free slots, mutates the original 'Rec' which should+-- not be reused after+unsafeRCons ::+ forall l t lts s. (RecSize lts ~ s, KnownNat s) => l := t -> Rec lts -> Rec (l := t ': lts)+unsafeRCons (_ := val) (Rec vec) =+ Rec $+ unsafePerformIO $!+ do m2 <- A.unsafeThawArray vec+ A.writeArray m2 size (unsafeCoerce# val)+ A.unsafeFreezeArray m2+ where+ size = fromIntegral $ natVal' (proxy# :: Proxy# s)+{-# INLINE unsafeRCons #-}++-- | Alias for 'rcons'+(&) :: forall l t lts s. (RecSize lts ~ s, KnownNat s) => l := t -> Rec lts -> Rec (l := t ': lts)+(&) = rcons+{-# INLINE (&) #-}++infixr 5 &++type family RecSize (lts :: [*]) :: Nat where+ RecSize '[] = 0+ RecSize (l := t ': lts) = 1 + RecSize lts++type family RecTyIdxH (i :: Nat) (l :: Symbol) (lts :: [*]) :: Nat where+ RecTyIdxH idx l (l := t ': lts) = idx+ RecTyIdxH idx m (l := t ': lts) = RecTyIdxH (1 + idx) m lts+ RecTyIdxH idx m '[] =+ TypeError+ ( 'Text "Could not find label "+ ':<>: 'Text m+ )++type family RecIdxTyH (i :: Nat) (r :: Nat) (lts :: [*]) :: * where+ RecIdxTyH idx idx (l := t ': lts) = t+ RecIdxTyH idx other (l := t ': lts) = RecIdxTyH idx (other + 1) lts+ RecIdxTyH idx other '[] =+ TypeError ('Text "Could not find index " ':<>: 'ShowType idx)++-- | State that a record contains a label. Leave idx an s free variables, used internally+type Has l lts idx s v =+ ( RecTyIdxH 0 l lts ~ idx+ , RecIdxTyH idx 0 lts ~ v+ , KnownNat idx+ , RecSize lts ~ s, KnownNat s+ )++-- | Get an existing record field+get :: forall l v lts idx s. (Has l lts idx s v) => FldProxy l -> Rec lts -> v+get _ (Rec vec) =+ let !size = fromIntegral $ natVal' (proxy# :: Proxy# s)+ !readAt = size - fromIntegral (natVal' (proxy# :: Proxy# idx)) - 1+ anyVal :: Any+ anyVal = A.indexArray vec readAt+ in unsafeCoerce# anyVal+{-# INLINE get #-}++-- | Alias for 'get'+(&.) :: forall l v lts idx s. (Has l lts idx s v) => Rec lts -> FldProxy l -> v+(&.) = flip get+infixl 3 &.++-- | Update an existing record field+set ::+ forall l v lts idx s.+ (Has l lts idx s v)+ => FldProxy l -> v -> Rec lts -> Rec lts+set _ !val (Rec vec) =+ let !size = fromIntegral $ natVal' (proxy# :: Proxy# s)+ !setAt = size - fromIntegral (natVal' (proxy# :: Proxy# idx)) - 1+ dynVal = unsafeCoerce# val+ r2 =+ unsafePerformIO $!+ do m2 <- A.newArray size (error "No Value")+ A.copyArray m2 0 vec 0 size+ A.writeArray m2 setAt dynVal+ Rec <$> A.unsafeFreezeArray m2+ in r2+{-# INLINE set #-}++-- | Path to the key that should be updated+data SPath (t :: [Symbol]) where+ SCons :: FldProxy l -> SPath ls -> SPath (l ': ls)+ SNil :: SPath '[]++-- | Alias for 'SNil'+snil :: SPath '[]+snil = SNil++{-# INLINE snil #-}++-- | Alias for 'SCons'+(&:) :: FldProxy l -> SPath ls -> SPath (l ': ls)+(&:) = SCons+infixr 8 &:++{-# INLINE (&:) #-}++type family RecDeepTy (ls :: [Symbol]) (lts :: k) :: * where+ RecDeepTy (l ': more) (Rec q) = RecDeepTy (l ': more) q+ RecDeepTy (l ': more) (l := Rec t ': lts) = RecDeepTy more t+ RecDeepTy (l ': more) (l := t ': lts) = t+ RecDeepTy (l ': more) (q := t ': lts) = RecDeepTy (l ': more) lts+ RecDeepTy '[] v = v++class SetPath k x where+ -- | Perform a deep update, setting the key along the path to the+ -- desired value+ setPath :: SPath k -> RecDeepTy k x -> x -> x++instance SetPath '[] v where+ setPath _ v _ = v+ {-# INLINE setPath #-}++instance+ ( SetPath more v+ , Has l lts idx s v+ , RecDeepTy (l ': more) (Rec lts) ~ RecDeepTy more v+ ) => SetPath (l ': more) (Rec lts)+ where+ setPath (SCons k more) v r =+ let innerVal = get k r+ in set k (setPath more v innerVal) r+ {-# INLINE setPath #-}++-- | Get keys of a record on value and type level+class RecKeys (lts :: [*]) where+ type RecKeysT lts :: [Symbol]+ recKeys :: t lts -> [String]++instance RecKeys '[] where+ type RecKeysT '[] = '[]+ recKeys _ = []++instance (KnownSymbol l, RecKeys lts) => RecKeys (l := t ': lts) where+ type RecKeysT (l := t ': lts) = (l ': RecKeysT lts)+ recKeys (_ :: f (l := t ': lts)) =+ let lbl :: FldProxy l+ lbl = FldProxy+ more :: Proxy lts+ more = Proxy+ in (symbolVal lbl : recKeys more)++-- | Apply a function to each key element pair for a record+reflectRec ::+ forall c r lts. (RecApply lts lts c)+ => Proxy c+ -> (forall a. c a => String -> a -> r)+ -> Rec lts+ -> [r]+reflectRec _ f r =+ recApply (\(Dict :: Dict (c a)) s v -> f s v) r (Proxy :: Proxy lts)+{-# INLINE reflectRec #-}++-- | Convert all elements of a record to a 'String'+showRec :: forall lts. (RecApply lts lts Show) => Rec lts -> [(String, String)]+showRec = reflectRec @Show Proxy (\k v -> (k, show v))++recToValue :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Value+recToValue r = toJSON $ reflectRec @ToJSON Proxy (\k v -> (T.pack k, toJSON v)) r++recToEncoding :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Encoding+recToEncoding r = pairs $ mconcat $ reflectRec @ToJSON Proxy (\k v -> (T.pack k .= v)) r++recJsonParser :: forall lts s. (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => Value -> Parser (Rec lts)+recJsonParser =+ withObject "Record" $ \o ->+ recJsonParse initSize o+ where+ initSize = fromIntegral $ natVal' (proxy# :: Proxy# s)++-- | Machinery needed to implement 'reflectRec'+class RecApply (rts :: [*]) (lts :: [*]) c where+ recApply :: (forall a. Dict (c a) -> String -> a -> r) -> Rec rts -> Proxy lts -> [r]++instance RecApply rts '[] c where+ recApply _ _ _ = []++instance+ ( KnownSymbol l+ , RecApply rts (RemoveAccessTo l lts) c+ , Has l rts idx s v+ , c v+ ) => RecApply rts (l := t ': lts) c where+ recApply f r (_ :: Proxy (l := t ': lts)) =+ let lbl :: FldProxy l+ lbl = FldProxy+ val = get lbl r+ res = f Dict (symbolVal lbl) val+ pNext :: Proxy (RemoveAccessTo l (l := t ': lts))+ pNext = Proxy+ in (res : recApply f r pNext)++-- | Machinery to implement equality+class RecEq (rts :: [*]) (lts :: [*]) where+ recEq :: Rec rts -> Rec rts -> Proxy lts -> Bool++instance RecEq rts '[] where+ recEq _ _ _ = True++instance+ ( RecEq rts (RemoveAccessTo l lts)+ , Has l rts idx s v+ , Eq v+ ) => RecEq rts (l := t ': lts) where+ recEq r1 r2 (_ :: Proxy (l := t ': lts)) =+ let lbl :: FldProxy l+ lbl = FldProxy+ val = get lbl r1+ val2 = get lbl r2+ res = val == val2+ pNext :: Proxy (RemoveAccessTo l (l := t ': lts))+ pNext = Proxy+ in res && recEq r1 r2 pNext++type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where+ RemoveAccessTo l (l := t ': lts) = RemoveAccessTo l lts+ RemoveAccessTo q (l := t ': lts) = (l := t ': RemoveAccessTo l lts)+ RemoveAccessTo q '[] = '[]++-- | Machinery to implement parseJSON+class RecJsonParse (lts :: [*]) where+ recJsonParse :: Int -> Object -> Parser (Rec lts)++instance RecJsonParse '[] where+ recJsonParse initSize _ = pure (unsafeRnil initSize)++instance+ ( KnownSymbol l, FromJSON t, RecJsonParse lts+ , RecSize lts ~ s, KnownNat s+ ) => RecJsonParse (l := t ': lts) where+ recJsonParse initSize obj =+ do let lbl :: FldProxy l+ lbl = FldProxy+ (v :: t) <- obj .: T.pack (symbolVal lbl)+ rest <- recJsonParse initSize obj+ pure $ unsafeRCons (lbl := v) rest++-- | Machinery for NFData+class RecNfData (lts :: [*]) (rts :: [*]) where+ recNfData :: Proxy lts -> Rec rts -> ()++instance RecNfData '[] rts where+ recNfData _ _ = ()++instance+ ( Has l rts idx s v+ , NFData v+ , RecNfData (RemoveAccessTo l lts) rts+ ) => RecNfData (l := t ': lts) rts where+ recNfData (_ :: (Proxy (l := t ': lts))) r =+ let !v = get (FldProxy :: FldProxy l) r+ pNext :: Proxy (RemoveAccessTo l (l := t ': lts))+ pNext = Proxy+ in deepseq v (recNfData pNext r)
+ superrecord.cabal view
@@ -0,0 +1,55 @@+name: superrecord+version: 0.1.0.0+synopsis: Supercharged anonymous records+description: Anonymous records with various useful utilities+homepage: https://github.com/agrafix/superrecord#readme+license: BSD3+license-file: LICENSE+author: Alexander Thiemann+maintainer: mail@athiemann.net+copyright: 2017 Alexander Thiemann <mail@athiemann.net>+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: SuperRecord+ build-depends: base >= 4.7 && < 5+ , primitive >= 0.6+ , constraints+ , aeson+ , text+ , deepseq+ , ghc-prim+ default-language: Haskell2010+ ghc-options: -Wall -O2++test-suite superrecord-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , superrecord+ , hspec+ , aeson+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++benchmark superrecord-bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: bench+ build-depends: base+ , superrecord+ , criterion+ , labels+ , bookkeeper+ , deepseq+ , aeson+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2++source-repository head+ type: git+ location: https://github.com/agrafix/superrecord
+ test/Spec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE DataKinds #-}+import SuperRecord++import Data.Aeson+import Test.Hspec++type Ex1 =+ '["foo" := String, "int" := Int]++r1 :: Rec Ex1+r1 =+ #foo := "Hi"+ & #int := 213+ & rnil++r2 :: Rec '["foo" := String]+r2 = #foo := "He" & rnil++polyFun :: Has "foo" lts idx s String => Rec lts -> String+polyFun = get #foo++rNested :: Rec '["foo" := Rec '["bar" := Int] ]+rNested =+ #foo := (#bar := 213 & rnil) & rnil++main :: IO ()+main = hspec $+ do it "getter works" $+ do get #foo r1 `shouldBe` "Hi"+ get #int r1 `shouldBe` 213+ polyFun r1 `shouldBe` "Hi"+ polyFun r2 `shouldBe` "He"+ get #bar (get #foo rNested) `shouldBe` 213+ rNested &. #foo &. #bar `shouldBe` 213+ it "setter works" $+ do let r1u = set #foo "Hey" r1+ get #foo r1 `shouldBe` "Hi"+ get #foo r1u `shouldBe` "Hey"+ get #int (set #int 123 r1) `shouldBe` 123+ set #int 213 (set #int 123 r1) `shouldBe` r1+ setPath (#foo &: #bar &: snil) 123 rNested+ `shouldBe` (#foo := (#bar := 123 & rnil) & rnil)+ it "getting record keys works" $+ do let vals = recKeys r1+ vals `shouldBe` ["foo", "int"]+ it "showRec words" $+ do let vals = showRec r1+ vals `shouldBe` [("foo", "\"Hi\""), ("int", "213")]+ it "show works" $+ show r1 `shouldBe` "[(\"foo\",\"\\\"Hi\\\"\"),(\"int\",\"213\")]"+ it "equality works" $+ do r1 == r1 `shouldBe` True+ r1 == set #foo "Hai" r1 `shouldBe` False+ it "toJSON matches fromJSON" $+ do decode (encode r1) `shouldBe` Just r1+ decode (encode r2) `shouldBe` Just r2+ decode (encode rNested) `shouldBe` Just rNested+ decode "{\"foo\": true}" `shouldBe` Just (#foo := True & rnil)