haskus-utils-variant 2.1.1 → 2.2
raw patch · 4 files changed
+72/−91 lines, 4 filesdep ~basedep ~haskus-utils-datadep ~haskus-utils-types
Dependency ranges changed: base, haskus-utils-data, haskus-utils-types, tasty, tasty-quickcheck, template-haskell
Files
- haskus-utils-variant.cabal +8/−8
- src/lib/Haskus/Utils/Variant.hs +9/−7
- src/lib/Haskus/Utils/VariantF.hs +2/−2
- src/tests/Variant.hs +53/−74
haskus-utils-variant.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.20 name: haskus-utils-variant-version: 2.1.1+version: 2.2 license: BSD3 license-file: LICENSE copyright: Sylvain Henry 2018@@ -32,10 +32,10 @@ default-language: Haskell2010 ghc-options: -Wall build-depends:- base >=4.9 && <4.12,- template-haskell >=2.13.0.0 && <2.14,- haskus-utils-types ==1.2.*,- haskus-utils-data ==1.1.*+ base >=4.9 && <5.0,+ template-haskell >=2.13.0.0,+ haskus-utils-types >=1.2,+ haskus-utils-data >=1.1 test-suite tests type: exitcode-stdio-1.0@@ -46,7 +46,7 @@ default-language: Haskell2010 ghc-options: -Wall -threaded build-depends:- base >=4.11.1.0 && <4.12,+ base >=4.11.1.0, haskus-utils-variant -any,- tasty >=0.11 && <1.2,- tasty-quickcheck >=0.8 && <0.11+ tasty >=0.11,+ tasty-quickcheck >=0.8
src/lib/Haskus/Utils/Variant.hs view
@@ -336,7 +336,7 @@ | otherwise -> Left (Variant t a) class SplitVariant as rs xs where- splitVariant' :: V xs -> Either (V as) (V (Complement rs as))+ splitVariant' :: V xs -> Either (V rs) (V as) instance SplitVariant as rs '[] where {-# INLINE splitVariant' #-}@@ -344,7 +344,7 @@ instance forall as rs xs x n m. ( n ~ MaybeIndexOf x as- , m ~ IndexOf x rs+ , m ~ MaybeIndexOf x rs , SplitVariant as rs xs , KnownNat m , KnownNat n@@ -353,16 +353,18 @@ {-# INLINE splitVariant' #-} splitVariant' (Variant 0 v) = case natValue' @n of- 0 -> Right (Variant (natValue' @m) v)- t -> Left (Variant (t-1) v)+ -- we assume that if `x` isn't in `as`, it is in `rs`+ -- hence we don't test if `m == 0`+ 0 -> Left (Variant (natValue' @m - 1) v)+ t -> Right (Variant (t-1) v) splitVariant' (Variant t v) = splitVariant' @as @rs (Variant (t-1) v :: V xs) -- | Split a variant in two splitVariant :: forall as xs.- ( SplitVariant as xs xs- ) => V xs -> Either (V as) (V (Complement xs as))-splitVariant = splitVariant' @as @xs+ ( SplitVariant as (Complement xs as) xs+ ) => V xs -> Either (V (Complement xs as)) (V as)+splitVariant = splitVariant' @as @(Complement xs as) @xs -- | A value of type "x" can be extracted from (V xs) type (:<) x xs =
src/lib/Haskus/Utils/VariantF.hs view
@@ -221,14 +221,14 @@ type SplitVariantF as xs e = ( Complement (ApplyAll e xs) (ApplyAll e as) ~ ApplyAll e (Complement xs as)- , SplitVariant (ApplyAll e as) (ApplyAll e xs) (ApplyAll e xs)+ , SplitVariant (ApplyAll e as) (ApplyAll e (Complement xs as)) (ApplyAll e xs) ) -- | Split a VariantF in two splitVariantF :: forall as xs e. ( SplitVariantF as xs e ) => VariantF xs e- -> Either (VariantF as e) (VariantF (Complement xs as) e)+ -> Either (VariantF (Complement xs as) e) (VariantF as e) splitVariantF (VariantF v) = bimap VariantF VariantF (splitVariant v) -- | Convert a VariantF into a multi-continuation
src/tests/Variant.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} module Variant ( testsVariant@@ -45,84 +46,62 @@ testsVariant :: TestTree testsVariant = testGroup "Variant" $- [ testProperty "set/get by index (match)"- (fromVariantAt @1 b == Just B)- , testProperty "set/get by index (dont' match)"- (fromVariantAt @0 b == Nothing)- , testProperty "set/get by type (match)"- (fromVariant (toVariant B :: ABC) == Just B)- , testProperty "set/get by type (don't match)"- (fromVariant @C (toVariant B :: ABC) == Nothing)-- , testProperty "variant equality (match)"- (b == b)- , testProperty "variant equality (don't match)"- (b /= toVariant C)-- , testProperty "update by index (match)"- (mapVariantAt @1 (const D) b == toVariantAt @1 D)- , testProperty "update by index (don't match)"- (mapVariantAt @0 (const F) b == toVariantAt @1 B)- , testProperty "update by type (match)"- (mapVariantFirst b2d b == toVariantAt @1 D)- , testProperty "update by type (don't match)"- (mapVariantFirst c2d b == toVariant B)- , testProperty "update/fold by index (match)"- (foldMapVariantAt @1 b2def b == toVariant E)- , testProperty "update/fold by index (don't match)"- (foldMapVariantAt @2 c2def b == toVariant B)-- , testProperty "Convert into tuple"- (variantToTuple b == (Nothing, Just B, Nothing))- , testProperty "Convert single variant"- (variantToValue (toVariant A :: V '[A]) == A)-- , testProperty "Lift Either: Left"- (variantFromEither (Left A :: Either A B) == toVariant A)- , testProperty "Lift Either: Right"- (variantFromEither (Right B :: Either A B) == toVariant B)-- , testProperty "To Either: Left"- (variantToEither (toVariant B :: V '[A,B]) == Left B)- , testProperty "To Either: Right"- (variantToEither (toVariant A :: V '[A,B]) == Right A)-- , testProperty "popVariantHead (match)"- (popVariantHead (toVariant A :: ABC) == Right A)- , testProperty "popVariantHead (don't match)"- (isLeft (popVariantHead b))-- , testProperty "popVariantAt (match)"- (popVariantAt @1 b == Right B)- , testProperty "popVariantAt (don't match)"- (isLeft (popVariantAt @2 b))-- , testProperty "popVariant (match)"- (popVariant @D (toVariantAt @4 D :: V '[A,B,C,B,D,E,D]) == Right D)- , testProperty "popVariant (match)"- (popVariant @D (toVariantAt @6 D :: V '[A,B,C,B,D,E,D]) == Right D)- , testProperty "popVariant (don't match)"- (popVariant @B (toVariantAt @4 D :: V '[A,B,C,B,D,E,D]) == Left (toVariantAt @2 D))+ [ testProperty "get by index (match)" $ fromVariantAt @1 b == Just B+ , testProperty "get by index (dont' match)" $ fromVariantAt @0 b == Nothing+ , testProperty "pattern V: set" $ (V A :: ABC) == (toVariant A :: ABC)+ , testProperty "pattern V: match" $ case (V A :: ABC) of+ V (x :: A) -> x == A+ V (_ :: B) -> False+ V (_ :: C) -> False+ _ -> undefined+ , testProperty "pattern V: match2" $ case (V B :: ABC) of+ V (_ :: A) -> False+ V (x :: B) -> x == B+ V (_ :: C) -> False+ _ -> undefined+ , testProperty "pattern V: type application" $ (V @Float 1.0 :: V '[Int,Float,String]) == toVariantAt @1 1.0+ , testProperty "get by type (match)" $ fromVariant (V B :: ABC) == Just B+ , testProperty "get by type (don't match)" $ fromVariant @C (V B :: ABC) == Nothing+ , testProperty "variant equality (match)" $ b == b+ , testProperty "variant equality (don't match)" $ b /= V C+ , testProperty "update by index (match)" $ mapVariantAt @1 (const D) b == toVariantAt @1 D+ , testProperty "update by index (don't match)" $ mapVariantAt @0 (const F) b == toVariantAt @1 B+ , testProperty "update by type (match)" $ mapVariantFirst b2d b == toVariantAt @1 D+ , testProperty "update by type (don't match)" $ mapVariantFirst c2d b == V B+ , testProperty "update/fold by index (match)" $ foldMapVariantAt @1 b2def b == V E+ , testProperty "update/fold by index (don't match)"$ foldMapVariantAt @2 c2def b == V B+ , testProperty "Convert into tuple" $ variantToTuple b == (Nothing, Just B, Nothing)+ , testProperty "Convert single variant" $ variantToValue (V A :: V '[A]) == A+ , testProperty "Lift Either: Left" $ variantFromEither (Left A :: Either A B) == V A+ , testProperty "Lift Either: Right" $ variantFromEither (Right B :: Either A B) == V B+ , testProperty "To Either: Left" $ variantToEither (V B :: V '[A,B]) == Left B+ , testProperty "To Either: Right" $ variantToEither (V A :: V '[A,B]) == Right A+ , testProperty "popVariantHead (match)" $ popVariantHead (V A :: ABC) == Right A+ , testProperty "popVariantHead (don't match)" $ isLeft (popVariantHead b)+ , testProperty "popVariantAt (match)" $ popVariantAt @1 b == Right B+ , testProperty "popVariantAt (don't match)" $ isLeft (popVariantAt @2 b) - , testProperty "prependVariant"- (fromVariantAt @4 (prependVariant @'[D,E,F] b) == Just B)- , testProperty "appendVariant"- (fromVariantAt @1 (appendVariant @'[D,E,F] b) == Just B)+ , testProperty "popVariant (match)" $ popVariant @D (toVariantAt @4 D :: V '[A,B,C,B,D,E,D]) == Right D+ , testProperty "popVariant (match)" $ popVariant @D (toVariantAt @6 D :: V '[A,B,C,B,D,E,D]) == Right D+ , testProperty "popVariant (don't match)" $ popVariant @B (toVariantAt @4 D :: V '[A,B,C,B,D,E,D]) == Left (toVariantAt @2 D) - , testProperty "alterVariant"- (alterVariant @Num (+1) (toVariant (1.0 :: Float) :: V '[Int,Float]) == toVariant (2.0 :: Float))- , testProperty "alterVariant"- (alterVariant @Num (+1) (toVariant (1.0 :: Float) :: V '[Float,Int]) == toVariant (2.0 :: Float))+ , testProperty "prependVariant" $ fromVariantAt @4 (prependVariant @'[D,E,F] b) == Just B+ , testProperty "appendVariant" $ fromVariantAt @1 (appendVariant @'[D,E,F] b) == Just B - , testProperty "traverseVariant"- (traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)- (toVariant (2.0 :: Float) :: V '[Float,Int]) == Just (toVariant (2.0 :: Float)))- , testProperty "traverseVariant"- (traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)- (toVariant (0.5 :: Float) :: V '[Float,Int]) == Nothing)+ , testProperty "alterVariant" $ alterVariant @Num (+1) (V @Float 1.0 :: V '[Int,Float]) == V @Float 2.0+ , testProperty "alterVariant" $ alterVariant @Num (+1) (V @Float 1.0 :: V '[Float,Int]) == V @Float 2.0 - , testProperty "liftVariant"- (fromVariant (liftVariant b :: V '[D,A,E,B,F,C]) == Just B)+ , testProperty "traverseVariant" $ traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)+ (V @Float 2.0 :: V '[Float,Int]) == Just (V @Float 2.0)+ , testProperty "traverseVariant" $ traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)+ (V @Float 0.5 :: V '[Float,Int]) == Nothing+ , testProperty "liftVariant" $ fromVariant (liftVariant b :: V '[D,A,E,B,F,C]) == Just B+ , testProperty "splitVariant" $ case splitVariant @'[A,C,D] (V A :: V '[A,B,C,D,E,F]) of+ Right (x :: V '[A,C,D]) -> x == V A+ Left (_ :: V '[B,E,F]) -> True+ , testProperty "splitVariant2" $ case splitVariant @'[A,C,D] (V E :: V '[A,B,C,D,E,F]) of+ Right (_ :: V '[A,C,D]) -> True+ Left (y :: V '[B,E,F]) -> y == V E ] class (Ord a, Num a) => OrdNum a