HList 0.5.0.0 → 0.5.1.0

raw patch · 13 files changed

+152/−34 lines, 13 filesdep ~basedep ~base-orphansPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, base-orphans

API changes (from Hackage documentation)

Files

• ChangeLog +9/−0
• Data/HList/HSort.hs +1/−1
• Data/HList/HZip.hs +1/−1
• Data/HList/Labelable.hs +3/−3
• Data/HList/RecordPuns.hs +36/−16
• Data/HList/RecordU.hs +4/−2
• Data/HList/TIP.hs +1/−1
• HList.cabal +12/−3
• README +12/−2
• examples/HListExample.hs +2/−0
• examples/HListExample/OverloadedLabels.hs +49/−0
• examples/HListExample/Pun.hs +1/−1
• examples/Properties/LengthDependent.hs +21/−4

@@ -1,3 +1,12 @@+23 Oct 2021+0.5.1 Release+Build & pass tests with ghc-8.4.4 through 9.2.0.20210821,+though with 9.2.0.20210821 dependencies for tests need+cabal flags --allow-newer=base --allow-newer=template-haskell,+and also invariant-functors and lens from git (as specified in `cabal.project`)++Add examples/HListExample/OverloadedLabels.hs+ 19 Feb 2018 0.5.0 Release Build & pass tests with ghc-7.6 through 8.4.0.20180209

@@ -130,7 +130,7 @@  instance HEqByFn le => HMSortBy le '[] '[] where hMSortBy _ x = x instance HEqByFn le => HMSortBy le '[x] '[x] where hMSortBy _ x = x-instance (HSort2 b x y ab, HEqBy le x y b) =>+instance (HSort2 b x y ab, HEqBy le x y b, HEqByFn le) =>     HMSortBy le '[x,y] ab where       hMSortBy _ (a `HCons` b `HCons` HNil) = hSort2 (Proxy :: Proxy b) a b 

@@ -98,7 +98,7 @@ instance HZip3 '[] '[] '[] where   hZip3 _ _ = HNil -instance (HList (x ': y) ~z, HZip3 xs ys zs) => HZip3 (x ': xs) (HList y ': ys) (z ': zs) where+instance (HList (x ': y) ~ z, HZip3 xs ys zs) => HZip3 (x ': xs) (HList y ': ys) (z ': zs) where   hZip3 (HCons x xs) (HCons y ys) = HCons x y  `HCons` hZip3 xs ys  data HZipF = HZipF

@@ -129,7 +129,7 @@ instance HLens x Record s t a b         => Labelable x Record s t a b where             type LabelableTy Record = LabelableLens-            hLens' = hLens+            hLens' x = hLens x  -- | used with 'toLabel' and/or '.==.' instance LabeledCxt1 s t a b => Labelable x LabeledR s t a b where@@ -167,7 +167,7 @@ instance LabelableTIPCxt x s t a b =>     Labelable (x :: k) TIP s t a b where     type LabelableTy TIP = LabelableLens-    hLens' = hLens+    hLens' x = hLens x  type LabelableTIPCxt x s t a b =      (s ~ t, a ~ b, Label x ~ Label a,@@ -236,7 +236,7 @@  > -- with the x defined as x = Label :: Label "x"  > let f x r = let  >          a = r ^. hLens x- >          b = r & hLens x .~ "6"+ >          b = r & hLens x .~ "7"  >        in (a,b)  It may work to use 'hLens'' instead of 'hLens' in the second code,

@@ -36,16 +36,18 @@  [@nesting@] -Nesting is supported. The idea is that variables inside-@{ }@ are in another record. More concretely:+Nesting is supported. Variables inside+@{ }@ and @( )@ are one level deeper, like the built-in syntax.+Furthermore the outer @{ }@ can be left out because @[pun|{x}|]@ is more+cluttered than @[pun|x|]@.+More concretely the pattern: -> [pun| ab@{ a b } y z c{d} |] -as a pattern, it will bindings from an original record @x@,-if you interpret (.) as a left-associative field lookup (as it-is in other languages):+> let [pun| ab@{ a b } y z c{d} |] = x -> let ab = xab+is short for:++> let ab = x.ab >     a = x.ab.a >     b = x.ab.b >     y = x.y@@ -53,26 +55,44 @@ >     -- c is not bound >     d = x.c.d -as an expression, it creates a new record which needs the variables-@ab a b y z d@ in-scope. @ab@ needs to be a record, and if it has-fields called @a@ or @b@ they are overridden by the values of @a@ and @b@-which are in scope.+Where here `.` is a left-associative field lookup (as it is in other languages). -@( )@ parens mean the same thing as @{ }@, except the pattern match-restricts the fields in the record supplied to be exactly the ones-provided. In other words+The pun quasiquoter can also be used in an expression context: -> [pun| (x _ y{}) |] = list+> let mkX ab a b y z d = [pun| ab@{ a b } y z c{d} |]+>     x = mkX ab b y z d++Here `mkX` includes @ab a b y z d@. @ab@ needs to be a record, and if it has+fields called @a@ or @b@ they are overridden by the values of @a@ and @b@ (via+'hLeftUnion' = '.<++.') . In other words,++> let mkX ab_ a b y z d = let ab = [pun| a b |] .<++. ab_+>                               in [pun| ab y z c{d} |]++For patterns, any order and additional fields are allowed if @{ }@ is used,+just as in built-in record syntax. But it is often necessary to restrict the+order and number of fields, such as if the record is a 'hRearrange' of a 'hLeftUnion'.+So use @( )@ instead:++> let [pun| (x _ y{}) |] = list > -- desugars to something like: > Record ((Tagged x :: Tagged "x" s1) `HCons` >         (Tagged _ :: Tagged t   s2) `HCons` >         (Tagged _ :: Tagged "y" s3) `HCons` >          HNil) = list -Where the @s1@ and @s2@ are allowed to fit whatever is in the HList. Note that this also introduces the familiar wild card pattern (@_@), and shows again how to ensure a label is present but not bind a variable to it.++For comparison, here are three equivalent ways to define variables `x` and `y`++> let [pun| x y{} |] = r+> let [pun|{ x y{} }|] = r -- or this+> let x = r .!. (Label :: Label "x")+>     y = constrainType (r .!. (Label :: Label "y"))+>     constrainType :: Record t -> Record t+>     constrainType = id  See also @examples/pun.hs@. In @{}@ patterns, @pun@ can work with 'Variant' too.

@@ -339,7 +339,7 @@     HLengthEq x n,     IArray UArray (GetElemTy x)    ) => RecordToRecordU x where-  recordToRecordU (rx @ (Record x)) = RecordU $ listArray+  recordToRecordU (rx@(Record x)) = RecordU $ listArray           (0, hNat2Integral (hLength x) - 1)           (hList2List (recordValues rx))  @@ -422,11 +422,13 @@           HLensCxt x RecordU s t a b)         => Labelable x RecordU s t a b where             type LabelableTy RecordU = LabelableLens-            hLens' = hLens+            hLens' x = hLens x  {- TODO instance Labelable x RecordUS to p f s t a b where instance (r ~ r', HasField l (Record r) v)       => HUpdateAtLabel RecordUS l v r r' where   hUpdateAtLabel = error "recordus hupdateatlabel"++Benchmarks -}

@@ -160,7 +160,7 @@ -} tipyLens f (TIP s) =       case hSplitAt (getN s f) (ghc8fix1 s) of-          (x, ta @ (Tagged a) `HCons` ys)+          (x, ta@(Tagged a) `HCons` ys)              | () <- ghc8fix2 ta ->               let mkt b = mkTIP (x `hAppendList` (tagSelf b `HCons` ys))               in mkt <$> f a

@@ -1,5 +1,5 @@ Name:                HList-Version:             0.5.0.0+Version:             0.5.1.0 Category:            Data Synopsis:            Heterogeneous lists Description:         HList provides many operations to create and manipulate@@ -18,6 +18,10 @@                     .                      User code should import "Data.HList" or                      "Data.HList.CommonMain" for a slightly more limited scope+                    .+                     The original design is described in <http://okmij.org/ftp/Haskell/HList-ext.pdf>,+                     though since that paper came out, the -XTypeFamiles extension has been used to+                     replace `TypeCast` with `~`. License:             MIT License-File:        LICENSE Author:              2004 Oleg Kiselyov (FNMOC, Monterey), Ralf Laemmel (CWI/VU, Amsterdam),@@ -26,7 +30,7 @@  Data-files:          README, ChangeLog Cabal-version:       >= 1.10-Tested-With:         GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1, GHC==8.4.0.20180209+Tested-With:         GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.6, GHC==9.0.1, GHC==9.2.0.20210821 Build-Type:          Simple  Extra-Source-Files:@@ -54,7 +58,7 @@                See <https://ghc.haskell.org/trac/ghc/ticket/9918>  library-  Build-Depends:       base >= 4.6 && < 4.12,+  Build-Depends:       base >= 4.6 && < 4.17,                        -- for Typeable '[] and '(:) with ghc-7.6                        base-orphans,                        -- Data.Semigroup for ghc < 8@@ -121,6 +125,9 @@   Other-Extensions:    CPP                        TemplateHaskell                        OverlappingInstances+  if impl(ghc >= 8.6)+    Default-Extensions: StarIsType+   if impl(ghc >= 8.0)     Default-Extensions: UndecidableSuperClasses @@ -133,6 +140,7 @@    if impl(ghc > 7.9)     Ghc-Options:      -fno-warn-unticked-promoted-constructors+                      -Wno-star-is-type    if flag(new_type_eq)     Cpp-options:       -DNEW_TYPE_EQ@@ -163,6 +171,7 @@         HListExample.Labelable         HListExample.MainGhcGeneric1         HListExample.MainPosting051106+        HListExample.OverloadedLabels         HListExample.Prism         HListExample.Pun         HListExample.TIPTransform

@@ -45,8 +45,18 @@ $ git clone https://bitbucket.org/HList/hlist HList $ cd HList; cabal install -The code works --- within the limits exercised in the source files ----for GHC-7.6, 7.8, 7.10, 8.2 and 8.4.0.20180209.+The code was tested --- within the limits exercised in the source files ---+with GHC:++  - 9.2.0.20210821+  - 9.0.1+  - 8.10.6+  - 8.8.4+  - 8.6.5+  - 8.4.4++and may still work with GHC-7.6, 7.8, 7.10, 8.2+ Older compilers are not supported.  One may run "cabal test" to check the distribution.

@@ -28,6 +28,7 @@ import HListExample.Pun import HListExample.TIPTransform import HListExample.TIPTransformM+import HListExample.OverloadedLabels   main = hspec $ do@@ -39,6 +40,7 @@   mainPun   mainTIPTransform   mainTTIPM+  mainOverloadedLabels   

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedLabels, TypeOperators, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances, ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes, PolyKinds, TypeApplications, DataKinds #-}+module HListExample.OverloadedLabels where++import Data.HList.CommonMain+import GHC.OverloadedLabels+import Control.Lens+import Data.HList.Labelable+import Properties.Common+import Test.Hspec+import GHC.TypeLits++{- | -XOverloadedLabels expands #foo into `hLens' (Label :: Label "foo")`+++Not in Data.HList.Labelable because it would overlap other uses of IsLabel+-}+instance (Labelable x r s t a b, x ~ x_,+    lens ~ ((a `p` f b) `to` (r s `p` f (r t))),+    ty ~ LabelableTy r,+    LabeledOpticF ty f,+    LabeledOpticP ty p,+    LabeledOpticTo ty x to +    ) => IsLabel x_ lens where+   fromLabel = hLens' (Label :: Label x)+++{- | hLens' where the `x` type parameter must be supplied by -XTypeApplications.+In other words these are all equivalent:++> hLens' (Label :: Label "abc")+> hLens' (Label @"abc")+> hL @"abc"+> `abc -- HListPP+ +-}+hL :: forall x r s t a b to p f.+     Labelable x r s t a b =>+     LabeledOptic x r s t a b +hL = hLens' (Label :: Label x)+++r = #abc .==. 3 .*. emptyRecord+++mainOverloadedLabels = describe "-XOverloadedLabels" $ do+ it "lookup" $ do+    r ^. #abc `shouldShowTo` "3"+    r ^. hL @"abc" `shouldShowTo` "3"

@@ -19,7 +19,7 @@ r2 = b .=. (a .=. 1 .*. emptyRecord) .*. emptyRecord  -p1 ( (.!. b) -> (b @ ((.!. a) -> a))) = (a,b)+p1 ( (.!. b) -> (b@((.!. a) -> a))) = (a,b)  p2 [pun| b @ {a} |] = (a, b) 

@@ -24,7 +24,13 @@ import Data.HList.CommonMain  +#if MIN_VERSION_template_haskell(2,17,0)+import Language.Haskell.TH.Lib.Internal hiding (doE)+import Language.Haskell.TH (Name, mkName, doE)+#else import Language.Haskell.TH+#endif+ import Test.QuickCheck import Properties.Common import Test.Hspec@@ -73,8 +79,14 @@                    |]                 ] +          myForallT :: [Name] -> TypeQ -> TypeQ+#if MIN_VERSION_template_haskell(2,17,0)+          myForallT ns = forallT [ plainInvisTV n inferredSpec | n <- ns ] (cxt [])+#else+          myForallT ns = forallT (map plainTV ns) (cxt [])+#endif           quantify :: TypeQ -> TypeQ-          quantify ty = forallT [ PlainTV (mkName ("x" ++ show i)) | i <- [1 .. n]] (return []) ty+          quantify = myForallT [ mkName ("x" ++ show i) | i <- [1 .. n]]             rss :: [TypeQ]@@ -263,14 +275,17 @@       let (x,y) = hUnzip xy       return $ xy `eq` hZip x y -#if __GLASGOW_HASKELL__ < 710+  it "hUnzip2/hZip2" $ property $ do+      xy <- genHL (BoolN True :: BoolN "x", BoolN True :: BoolN "y")+      let (x,y) = hUnzip2 xy+      return $ xy `eq` hZip2 x y+   -- XXX doesn't work with ghc-7.10.1   -- (should be fixed for 7.10.2)   it "hZip/hZip2" $ property $ do       x <- genHL (BoolN True :: BoolN "x")       y <- genHL (BoolN True :: BoolN "y")       return $ hZip x y `eq` hZip2 x y-#endif    -- lots of duplication, not sure if it's worth factoring out   it "HList monoid unit" $@@ -324,7 +339,7 @@         s:ss = map sort (permutations xyz)     return $ all (s ==) ss -#if __GLASGOW_HASKELL__ > 707+#if __GLASGOW_HASKELL__ > 707 && __GLASGOW_HASKELL__ < 901   -- ghc-7.6 has no ordering for Nat (only for HNat)   it "hSort (the labels)" $ property $ do     x <- $(rN n1) True@@ -352,6 +367,7 @@               | i <- [1 .. n1],                 let ln = [| Label :: Label $(litT (numTyLit (fromIntegral i))) |]             ])+#if __GLASGOW_HASKELL__ < 901   it "rearranged / hMapR" $ property $ do     r <- $(rN n1) True     let revR = r & from hListRecord %~ hReverse@@ -359,6 +375,7 @@         asT _ = id     -- hMap works on the reversed list     return $ hMapR not r === (r & rearranged' . asT revR . unlabeled %~ hMap not)+#endif     it "hOccurs" $ property $ do