hvect 0.3.1.0 → 0.4.0.0

raw patch · 6 files changed

+169/−113 lines, 6 filesdep +hspecdep −HTFdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependencies removed: HTF

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• hvect.cabal +8/−7
• src/Data/HVect.hs +27/−18
• test/Data/HVectSpec.hs +126/−0
• test/Data/HVectTest.hs +0/−82
• test/Test.hs +7/−5

@@ -1,5 +1,5 @@ Copyright (c) 2014 - 2015 Tim Baumann <tim@timbaumann.info>-Copyright (c) 2014 - 2016 Alexander Thiemann <mail@athiemann.net>+Copyright (c) 2014 - 2017 Alexander Thiemann <mail@athiemann.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the

@@ -1,5 +1,5 @@ name:                hvect-version:             0.3.1.0+version:             0.4.0.0 synopsis:            Simple strict heterogeneous lists description:         Small, concise and simple implementation of heterogeneous lists with useful utility functions homepage:            https://github.com/agrafix/hvect@@ -8,17 +8,17 @@ license-file:        LICENSE author:              Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info> maintainer:          Alexander Thiemann <mail@athiemann.net>-copyright:           (c) 2014 - 2016 Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info>+copyright:           (c) 2014 - 2017 Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info> category:            Data build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC==7.8.4, GHC==7.10.2+tested-with:         GHC==7.10.2, GHC==8.0.1 extra-source-files:     README.md  library   exposed-modules:     Data.HVect-  build-depends:       base >=4.7 && <5+  build-depends:       base >= 4.8 && <5   hs-source-dirs:      src   default-language:    Haskell2010 @@ -26,10 +26,11 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Test.hs-  other-modules:       Data.HVectTest-  build-depends:       base >=4.6 && <5,+  default-language:    Haskell2010+  other-modules:       Data.HVectSpec+  build-depends:       base >= 4.8 && <5,                        hvect,-                       HTF >=0.12.2.4+                       hspec >= 2.2   ghc-options: -Wall  source-repository head

@@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}@@ -26,12 +27,15 @@   , Rep (..), HasRep (..)   , curryExpl, curry   , packExpl, pack+    -- * type class constraints on list elements+  , AllHave     -- * type level numeric utilities   , Nat (..), SNat (..), sNatToInt   , intToSNat, AnySNat (..)   , (:<)   ) where +import GHC.Exts import Prelude hiding (reverse, uncurry, curry, head, null, (!!), length, tail)  -- | Heterogeneous vector@@ -39,6 +43,8 @@   HNil :: HVect '[]   (:&:) :: !t -> !(HVect ts) -> HVect (t ': ts) +infixr 5 :&:+ instance Eq (HVect '[]) where     _ == _ =         True@@ -79,22 +85,26 @@     Append (a ': as) bs = a ': (Append as bs)  type family InList (x :: *) (xs :: [*]) :: Nat where-    InList x (x ': ys) = Zero-    InList x (y ': ys) = Succ (InList x ys)+    InList x (x ': ys) = 'Zero+    InList x (y ': ys) = 'Succ (InList x ys) +type family AllHave (c :: * -> Constraint) (xs :: [*]) :: Constraint where+    AllHave c '[] = 'True ~ 'True+    AllHave c (x ': xs) = (c x, AllHave c xs)+ class SNatRep n where     getSNat :: SNat n -instance SNatRep Zero where+instance SNatRep 'Zero where     getSNat = SZero -instance SNatRep n => SNatRep (Succ n) where+instance SNatRep n => SNatRep ('Succ n) where     getSNat = SSucc getSNat  type family NotInList (x :: *) (xs :: [*]) :: Bool where-    NotInList x (x ': ys) = False+    NotInList x (x ': ys) = 'False     NotInList x (y ': ys) = NotInList x ys-    NotInList x '[] = True+    NotInList x '[] = 'True  type ListContains n x ts = (SNatRep n, InList x ts ~ n, HVectIdx n ts ~ x) @@ -144,35 +154,34 @@     Succ :: Nat -> Nat  data SNat (n :: Nat) where-    SZero :: SNat Zero-    SSucc :: SNat n -> SNat (Succ n)+    SZero :: SNat 'Zero+    SSucc :: SNat n -> SNat ('Succ n)  data AnySNat where     AnySNat :: forall n. SNat n -> AnySNat  type family HVectLen (ts :: [*]) :: Nat where-    HVectLen '[] = Zero-    HVectLen (t ': ts) = Succ (HVectLen ts)+    HVectLen '[] = 'Zero+    HVectLen (t ': ts) = 'Succ (HVectLen ts)  type family HVectIdx (n :: Nat) (ts :: [*]) :: * where-    HVectIdx Zero (a ': as) = a-    HVectIdx (Succ n) (a ': as) = HVectIdx n as+    HVectIdx 'Zero (a ': as) = a+    HVectIdx ('Succ n) (a ': as) = HVectIdx n as  type family (m :: Nat) :< (n :: Nat) :: Bool where-    m :< Zero = False-    Zero :< (Succ n) = True-    (Succ m) :< (Succ n) = m :< n+    m :< 'Zero = 'False+    'Zero :< ('Succ n) = 'True+    ('Succ m) :< ('Succ n) = m :< n  type family (m :: Nat) :- (n :: Nat) :: Nat where-    n :- Zero = n-    (Succ m) :- (Succ n) = m :- n+    n :- 'Zero = n+    ('Succ m) :- ('Succ n) = m :- n  (!!) :: SNat n -> HVect as -> HVectIdx n as SZero !! (a :&: _) = a (SSucc s) !! (_ :&: as) = s !! as _ !! _ = error "HVect !!: This should never happen" -infixr 5 :&: infixr 5 <++> infixl 9 !! 

@@ -0,0 +1,126 @@+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-overlapping-patterns #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}+module Data.HVectSpec (spec) where++import Data.HVect+import Test.Hspec+import qualified Data.HVect as HV++spec :: Spec+spec =+    do teqInstance+       tordInstance+       treverse+       thead+       ttail+       tnull+       tconcat+       tcurryUncurry+       tlength+       tidxAccess+       tgetFirst+       tallHave++teqInstance :: Spec+teqInstance =+    it "eqInstance" $+    do ("foo" :&: "bar" :&: empty == "foo" :&: "bar" :&: empty) `shouldBe` True+       ("foo" :&: True :&: empty == "foo" :&: True :&: empty) `shouldBe` True+       ("foo" :&: False :&: empty /= "foo" :&: True :&: empty) `shouldBe` True++tordInstance :: Spec+tordInstance =+    it "ordInstance" $+   do ((1 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 2 :&: 3 :&: empty))+          `shouldBe` ([1, 2, 3] `compare` [1, 2, 3])+      ((3 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 2 :&: 3 :&: empty))+          `shouldBe` ([3, 2, 3] `compare` [1, 2, 3])+      ((3 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 1 :&: 3 :&: empty))+          `shouldBe` ([1, 2, 3] `compare` [1, 1, 3])+      ((1 :&: 2 :&: 3 :&: empty) <= (1 :&: 2 :&: 3 :&: empty))+          `shouldBe` ([1, 2, 3] <= [1, 2, 3])+      ((3 :&: 2 :&: 3 :&: empty) <= (1 :&: 2 :&: 3 :&: empty))+          `shouldBe` ([3, 2, 3] <= [1, 2, 3])+      ((3 :&: 2 :&: 3 :&: empty) <= (1 :&: 1 :&: 3 :&: empty))+          `shouldBe` ([1, 2, 3] <= [1, 1, 3])+      ((1 :&: 2 :&: True :&: empty) `compare` (1 :&: 2 :&: True :&: empty))+          `shouldBe` EQ+      ((1 :&: "foo" :&: True :&: empty) `compare` (1 :&: "bar" :&: True :&: empty))+          `shouldBe` ("foo" `compare` "bar")++treverse :: Spec+treverse =+    it "reverse" $+    do (HV.reverse empty) `shouldBe` empty+       (HV.reverse $ 1 :&: 2 :&: empty) `shouldBe` (2 :&: 1 :&: empty)+       (HV.reverse $ 1 :&: "foo" :&: True :&: empty) `shouldBe` (True :&: "foo" :&: 1 :&: empty)++thead :: Spec+thead =+    it "head" $+    do (HV.head $ 1 :&: empty) `shouldBe` 1+       (HV.head $ 1 :&: 2 :&: empty) `shouldBe` 1++ttail :: Spec+ttail =+    it "tail" $+    do (HV.tail $ 1 :&: empty) `shouldBe` empty+       (HV.tail $ 1 :&: 2 :&: empty) `shouldBe` (2 :&: empty)++tnull :: Spec+tnull =+    it "null" $+    do (HV.null empty) `shouldBe` True+       (not $ HV.null $ 1 :&: empty) `shouldBe`  True++tconcat :: Spec+tconcat =+    it "concat" $+    do ((1 :&: 2 :&: empty) <++> ("foo" :&: "bar" :&: empty))+           `shouldBe` (1 :&: 2 :&: "foo" :&: "bar" :&: empty)+       ((1 :&: 2 :&: empty) <++> empty)+           `shouldBe` (1 :&: 2 :&: empty)++tcurryUncurry :: Spec+tcurryUncurry =+    it "curry uncurry" $+    do (fun (1 :&: 2 :&: empty)) `shouldBe` "12"+       (HV.curry fun 1 2) `shouldBe` "12"+       (HV.uncurry (HV.curry fun) (1 :&: 2 :&: empty)) `shouldBe` "12"+    where+      fun :: HVect [Int, Int] -> String+      fun (a :&: b  :&: HNil) = show a ++ show b+      fun _ = "OOPS!"++tlength :: Spec+tlength =+    it "length" $+    do (sNatToInt $ HV.length empty)  `shouldBe` 0+       (sNatToInt $ HV.length ("foo" :&: "bar" :&: empty)) `shouldBe` 2+       (sNatToInt $ HV.length ("aaa" :&: False :&: True :&: "foo" :&: "bar" :&: empty)) `shouldBe` 5++tidxAccess :: Spec+tidxAccess =+    it "idxAccess" $+    do (SZero HV.!! ("foo" :&: "bar" :&: empty))  `shouldBe` "foo"+       (SSucc SZero HV.!! ("foo" :&: "bar" :&: empty))  `shouldBe` "bar"+       (SSucc (SSucc SZero) HV.!! (True :&: "foo" :&: "bar" :&: empty)) `shouldBe` "bar"++tgetFirst :: Spec+tgetFirst =+    it "getFirst" $+    do (findFirst (intOne :&: True :&: False :&: "foo" :&: empty)) `shouldBe` True+       (findFirst (intOne :&: True :&: False :&: "foo" :&: empty) == intOne) `shouldBe` True+    where+      intOne :: Int+      intOne = 1++tallHave :: Spec+tallHave =+    it "allHave" $+    (showLocal $ 1 :&: 2 :&: True :&: empty) `shouldBe` ["1", "2", "True"]+    where+        showLocal :: AllHave Show ts => HVect ts -> [String]+        showLocal HNil = []+        showLocal (t :&: ts) = (show t : showLocal ts)

@@ -1,82 +0,0 @@-{-# OPTIONS_GHC -fno-warn-type-defaults -F -pgmF htfpp #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}-module Data.HVectTest (htf_thisModulesTests) where--import Test.Framework-import Data.HVect-import qualified Data.HVect as HV--test_eqInstance :: IO ()-test_eqInstance =-    do assertBool ("foo" :&: "bar" :&: empty == "foo" :&: "bar" :&: empty)-       assertBool ("foo" :&: True :&: empty == "foo" :&: True :&: empty)-       assertBool ("foo" :&: False :&: empty /= "foo" :&: True :&: empty)--test_ordInstance :: IO ()-test_ordInstance =-   do assertEqual ([1, 2, 3] `compare` [1, 2, 3]) ((1 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 2 :&: 3 :&: empty))-      assertEqual ([3, 2, 3] `compare` [1, 2, 3]) ((3 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 2 :&: 3 :&: empty))-      assertEqual ([1, 2, 3] `compare` [1, 1, 3]) ((3 :&: 2 :&: 3 :&: empty) `compare` (1 :&: 1 :&: 3 :&: empty))-      assertEqual ([1, 2, 3] <= [1, 2, 3]) ((1 :&: 2 :&: 3 :&: empty) <= (1 :&: 2 :&: 3 :&: empty))-      assertEqual ([3, 2, 3] <= [1, 2, 3]) ((3 :&: 2 :&: 3 :&: empty) <= (1 :&: 2 :&: 3 :&: empty))-      assertEqual ([1, 2, 3] <= [1, 1, 3]) ((3 :&: 2 :&: 3 :&: empty) <= (1 :&: 1 :&: 3 :&: empty))-      assertEqual EQ ((1 :&: 2 :&: True :&: empty) `compare` (1 :&: 2 :&: True :&: empty))-      assertEqual ("foo" `compare` "bar") ((1 :&: "foo" :&: True :&: empty) `compare` (1 :&: "bar" :&: True :&: empty))--test_reverse :: IO ()-test_reverse =-    do assertEqual empty (HV.reverse empty)-       assertEqual (2 :&: 1 :&: empty) (HV.reverse $ 1 :&: 2 :&: empty)-       assertEqual (True :&: "foo" :&: 1 :&: empty) (HV.reverse $ 1 :&: "foo" :&: True :&: empty)--test_head :: IO ()-test_head =-    do assertEqual 1 (HV.head $ 1 :&: empty)-       assertEqual 1 (HV.head $ 1 :&: 2 :&: empty)--test_tail :: IO ()-test_tail =-    do assertEqual empty (HV.tail $ 1 :&: empty)-       assertEqual (2 :&: empty) (HV.tail $ 1 :&: 2 :&: empty)--test_null :: IO ()-test_null =-    do assertBool (HV.null empty)-       assertBool (not $ HV.null $ 1 :&: empty)--test_concat :: IO ()-test_concat =-    do assertEqual (1 :&: 2 :&: "foo" :&: "bar" :&: empty) ((1 :&: 2 :&: empty) <++> ("foo" :&: "bar" :&: empty))-       assertEqual (1 :&: 2 :&: empty) ((1 :&: 2 :&: empty) <++> empty)---test_curryUncurry :: IO ()-test_curryUncurry =-    do assertEqual "12" (fun (1 :&: 2 :&: empty))-       assertEqual "12" (HV.curry fun 1 2)-       assertEqual "12" (HV.uncurry (HV.curry fun) (1 :&: 2 :&: empty))-    where-      fun :: HVect [Int, Int] -> String-      fun (a :&: b  :&: HNil) = show a ++ show b-      fun _ = "OOPS!"--test_length :: IO ()-test_length =-    do assertEqual 0 (sNatToInt $ HV.length empty)-       assertEqual 2 (sNatToInt $ HV.length ("foo" :&: "bar" :&: empty))-       assertEqual 5 (sNatToInt $ HV.length ("aaa" :&: False :&: True :&: "foo" :&: "bar" :&: empty))--test_idxAccess :: IO ()-test_idxAccess =-    do assertEqual "foo" (SZero HV.!! ("foo" :&: "bar" :&: empty))-       assertEqual "bar" (SSucc SZero HV.!! ("foo" :&: "bar" :&: empty))-       assertEqual "bar" (SSucc (SSucc SZero) HV.!! (True :&: "foo" :&: "bar" :&: empty))--test_getFirst :: IO ()-test_getFirst =-    do assertEqual True (findFirst (intOne :&: True :&: False :&: "foo" :&: empty))-       assertEqual intOne (findFirst (intOne :&: True :&: False :&: "foo" :&: empty))-    where-      intOne :: Int-      intOne = 1

@@ -1,8 +1,10 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-module Main where+module  Main where -import Test.Framework-import {-@ HTF_TESTS @-} Data.HVectTest+import qualified Data.HVectSpec +import Test.Hspec+ main :: IO ()-main = htfMain htf_importedTests+main =+    hspec $+    Data.HVectSpec.spec