git.iko.soy/generic-lens
on master help sign in
Add tests for overloaded labels
commit2411156909781d99507e67f4d7898b429919dfc1 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateTue 27 Nov 2018, 14:01 (8 years ago) parent82d5326
3 files changed+20−3
compare with master
unifiedsplit
generic-lens.cabal+1 src/Data/Generics/Labels.hs+1−3 test/Spec.hs+18
generic-lens.cabal+1
@@ -34,6 +34,7 @@ library
3434 , Data.Generics.Product.Types
3535 , Data.Generics.Product.Constraints
3636 , Data.Generics.Product.HList
37+ , Data.Generics.Labels
3738 , Data.Generics.Internal.GenericN
3839
3940 , Data.Generics.Sum
src/Data/Generics/Labels.hs+1−3
@@ -13,13 +13,12 @@
1313{-# LANGUAGE UndecidableInstances #-}
1414{-# OPTIONS_GHC -Wno-orphans #-}
1515
16−
1716--------------------------------------------------------------------------------
1817-- |
1918-- Module : Data.Generics.Labels
2019-- Copyright : (C) 2018 Csongor Kiss
21−-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2220-- License : BSD3
21+-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
2322-- Stability : experimental
2423-- Portability : non-portable
2524--
@@ -48,7 +47,6 @@ import Data.Type.Equality (type (==))
4847import GHC.OverloadedLabels
4948import GHC.TypeLits
5049
51−
5250-- $sec1
5351-- An instance for creating lenses and prisms with @#identifiers@ from the
5452-- @OverloadedLabels@ extension. Note that since overloaded labels do not
test/Spec.hs+18
@@ -10,6 +10,7 @@
1010{-# LANGUAGE ScopedTypeVariables #-}
1111{-# LANGUAGE TypeApplications #-}
1212{-# LANGUAGE TemplateHaskell #-}
13+{-# LANGUAGE OverloadedLabels #-}
1314
1415module Main where
1516
@@ -23,6 +24,9 @@ import System.Exit
2324import Data.Generics.Internal.VL.Lens
2425import Data.Generics.Internal.VL.Prism
2526import Data.Generics.Internal.VL.Traversal
27+import Control.Lens (_1, (+~))
28+import Data.Function ((&))
29+import Data.Generics.Labels ()
2630
2731-- This is sufficient at we only want to test that they typecheck
2832import Test24 ()
@@ -223,6 +227,12 @@ sum2TypePrism = _Typed @Int
223227sum2TypePrismChar :: Prism Sum2 Sum2 Char Char
224228sum2TypePrismChar = _Typed @Char
225229
230+data SumOfProducts =
231+ RecA { foo :: Int, valA :: String }
232+ | RecB { foo :: Int, valB :: Bool }
233+ | RecC { foo :: Int }
234+ deriving (Show, Eq, Generic)
235+
226236tests :: Test
227237tests = TestList $ map mkHUnitTest
228238 [ $(inspectTest $ 'fieldALensManual === 'fieldALensName)
@@ -247,6 +257,14 @@ tests = TestList $ map mkHUnitTest
247257 -- TODO [1.0.0.0]: these tests pass with the new implementation
248258-- , $(inspectTest $ 'sum3Param1Manual === 'sum3Param1Derived)
249259-- , $(inspectTest $ 'sum3Param2Manual === 'sum3Param2Derived)
260+ ] ++
261+ -- Tests for overloaded labels
262+ [ (valLabel ^. #foo ) ~=? 3
263+ , (valLabel & #foo +~ 10 ) ~=? RecB 13 True
264+ , (valLabel ^? #_RecB ) ~=? Just (3, True)
265+ , (valLabel ^? #_RecB . _1) ~=? Just 3
266+ , (valLabel ^? #_RecC ) ~=? Nothing
250267 ]
268+ where valLabel = RecB 3 True
251269
252270-- TODO: add test for traversals over multiple types