git.iko.soy/jrec
on master help sign in
Put tests in test/
451841cSridhar Ratnakumar
jrec.cabal+32−2
compare with master
unifiedsplit
@@ -62,7 +62,6 @@ library
62 , ghc-prim
62 , ghc-prim
63 , lens
63 , lens
64 , mtl
64 , mtl
65− , tasty-hunit
66 , text
65 , text
67
66
68 default-language: Haskell2010
67 default-language: Haskell2010
@@ -74,5 +73,36 @@ test-suite jrec-test
74 build-depends:
73 build-depends:
75 base,
74 base,
76 hspec,
75 hspec,
77− QuickCheck
76+ QuickCheck,
77+ lens,
78+ jrec
78 default-language: Haskell2010
79 default-language: Haskell2010
80+ default-extensions:
81+ BlockArguments
82+ DataKinds
83+ DeriveGeneric
84+ DerivingStrategies
85+ DuplicateRecordFields
86+ FlexibleContexts
87+ FlexibleInstances
88+ FunctionalDependencies
89+ GADTs
90+ InstanceSigs
91+ KindSignatures
92+ LambdaCase
93+ MultiParamTypeClasses
94+ OverloadedLabels
95+ OverloadedStrings
96+ PatternSynonyms
97+ RankNTypes
98+ ScopedTypeVariables
99+ StandaloneDeriving
100+ TupleSections
101+ TypeFamilies
102+ TypeOperators
103+ UndecidableInstances
104+ UnicodeSyntax
105+ ViewPatterns
106+ ConstraintKinds
107+
108+
src/JRec.hs−52
@@ -10,12 +10,6 @@ module JRec
10 pattern ExactRecord,
10 pattern ExactRecord,
11 unField,
11 unField,
12 union,
12 union,
13−
14− -- * Tests
15− unit_polymorphic,
16− unit_show,
17− unit_get,
18− unit_set,
19 )
13 )
20where
14where
21
15
@@ -33,7 +27,6 @@ import Control.Lens ((&), (^.))
33import JRec.Super ((:=))
27import JRec.Super ((:=))
34import JRec.Tuple
28import JRec.Tuple
35import JRec.Field
29import JRec.Field
36−import Test.Tasty.HUnit
37import Unsafe.Coerce
30import Unsafe.Coerce
38
31
39----------------------------------------------------------------------------
32----------------------------------------------------------------------------
@@ -122,51 +115,6 @@ instance {-# OVERLAPPING #-} (R.Set field fields a' ~ fields', R.Set field field
122instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GL.HasField' field (Record fields) a where
115instance {-# OVERLAPPING #-} (R.Set field fields a ~ fields, R.Has field fields a) => GL.HasField' field (Record fields) a where
123 field' = coerced @(Record fields) @_ @(R.Rec fields) @_ . R.lens (R.FldProxy @field)
116 field' = coerced @(Record fields) @_ @(R.Rec fields) @_ . R.lens (R.FldProxy @field)
124
117
125−unit_polymorphic :: IO ()
126−unit_polymorphic = do
127− (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6) & #u .~ 5)
128− @?= ExactRecord (#u :=: 5, #a :=: 5, #b :=: 6)
129−
130−----------------------------------------------------------------------------
131−-- Tests
132−----------------------------------------------------------------------------
133−
134−unit_show :: IO ()
135−unit_show = do
136− show (ExactRecord ()) @?= "{}"
137− show (ExactRecord (#foo :=: True)) @?= "{foo = True}"
138− show (ExactRecord (#foo :=: True, #bar :=: 0)) @?= "{foo = True, bar = 0}"
139−
140−unit_get :: IO ()
141−unit_get = do
142− let getA1 :: Record ("a" :=: Int ': rest) -> Int
143− getA1 = (^. #a)
144− let getA2 :: Record ("u" :=: Bool ': "a" :=: Int ': rest) -> Int
145− getA2 = (^. #a)
146− getA1 (ExactRecord (#a :=: 5)) @?= 5
147− getA1 (ExactRecord (#a :=: 5, #b :=: 6)) @?= 5
148− getA2 (ExactRecord (#u :=: True, #a :=: 5)) @?= 5
149− getA2 (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6)) @?= 5
150−
151−unit_set :: IO ()
152−unit_set = do
153− let setA1 ::
154− Record ("a" :=: Int ': rest) ->
155− Record ("a" :=: Int ': rest)
156− setA1 = (#a .~ 8)
157− let setA2 ::
158− Record ("u" :=: Bool ': "a" :=: Int ': rest) ->
159− Record ("u" :=: Bool ': "a" :=: Int ': rest)
160− setA2 = (#a .~ 8)
161− setA1 (ExactRecord (#a :=: 5))
162− @?= (ExactRecord (#a :=: 8))
163− setA1 (ExactRecord (#a :=: 5, #b :=: 6))
164− @?= (ExactRecord (#a :=: 8, #b :=: 6))
165− setA2 (ExactRecord (#u :=: True, #a :=: 5))
166− @?= (ExactRecord (#u :=: True, #a :=: 8))
167− setA2 (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6))
168− @?= (ExactRecord (#u :=: True, #a :=: 8, #b :=: 6))
169−
170pattern ExactRecord :: RecTuple tuple fields => tuple -> Record fields
118pattern ExactRecord :: RecTuple tuple fields => tuple -> Record fields
171pattern ExactRecord a <-
119pattern ExactRecord a <-
172 MkRecord (toTuple -> a)
120 MkRecord (toTuple -> a)
test/JRecSpec.hs+37−1
@@ -1,7 +1,43 @@
1module JRecSpec (spec) where
1module JRecSpec (spec) where
2
2
3import Test.Hspec
3import Test.Hspec
4+import Control.Lens ((&), (^.), (.~))
5+import JRec
4
6
5spec :: Spec
7spec :: Spec
6spec = do
8spec = do
7− pure ()
9+ it "polymorphic" $ do
10+ (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6) & #u .~ 5)
11+ `shouldBe` ExactRecord (#u :=: 5, #a :=: 5, #b :=: 6)
12+ it "show" $ do
13+ show (ExactRecord ()) `shouldBe` "{}"
14+ show (ExactRecord (#foo :=: True)) `shouldBe` "{foo = True}"
15+ show (ExactRecord (#foo :=: True, #bar :=: 0)) `shouldBe` "{foo = True, bar = 0}"
16+ it "get" $ do
17+ let getA1 :: Record ("a" :=: Int ': rest) -> Int
18+ getA1 = (^. #a)
19+ let getA2 :: Record ("u" :=: Bool ': "a" :=: Int ': rest) -> Int
20+ getA2 = (^. #a)
21+ getA1 (ExactRecord (#a :=: 5)) `shouldBe` 5
22+ getA1 (ExactRecord (#a :=: 5, #b :=: 6)) `shouldBe` 5
23+ getA2 (ExactRecord (#u :=: True, #a :=: 5)) `shouldBe` 5
24+ getA2 (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6)) `shouldBe` 5
25+ it "set" $ do
26+ let setA1 ::
27+ Record ("a" :=: Int ': rest) ->
28+ Record ("a" :=: Int ': rest)
29+ setA1 = (#a .~ 8)
30+ let setA2 ::
31+ Record ("u" :=: Bool ': "a" :=: Int ': rest) ->
32+ Record ("u" :=: Bool ': "a" :=: Int ': rest)
33+ setA2 = (#a .~ 8)
34+ setA1 (ExactRecord (#a :=: 5))
35+ `shouldBe` (ExactRecord (#a :=: 8))
36+ setA1 (ExactRecord (#a :=: 5, #b :=: 6))
37+ `shouldBe` (ExactRecord (#a :=: 8, #b :=: 6))
38+ setA2 (ExactRecord (#u :=: True, #a :=: 5))
39+ `shouldBe` (ExactRecord (#u :=: True, #a :=: 8))
40+ setA2 (ExactRecord (#u :=: True, #a :=: 5, #b :=: 6))
41+ `shouldBe` (ExactRecord (#u :=: True, #a :=: 8, #b :=: 6))
42+
43+