variant-1.0: src/tests/Variant.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Variant
( testsVariant
)
where
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Data.Either
import Data.Variant
import Data.Variant.ContFlow
data A = A deriving (Show,Eq)
data B = B deriving (Show,Eq)
data C = C deriving (Show,Eq)
data D = D deriving (Show,Eq)
data E = E deriving (Show,Eq)
data F = F deriving (Show,Eq)
type ABC = V '[A,B,C]
type DEF = V '[D,E,F]
b :: ABC
b = toVariantAt @1 B
b2d :: B -> D
b2d = const D
c2d :: C -> D
c2d = const D
b2def :: B -> DEF
b2def = const (toVariant E)
c2def :: C -> DEF
c2def = const (toVariant E)
testsVariant :: TestTree
testsVariant = testGroup "Variant" $
[ 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 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 "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 "prependVariant" $ fromVariantAt @4 (prependVariant @'[D,E,F] b) == Just B
, testProperty "appendVariant" $ fromVariantAt @1 (appendVariant @'[D,E,F] b) == Just B
, 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 "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
, testProperty "toCont" $ (toCont (V E :: V '[A,B,C,D,E,F]) >::>
( \(_ :: A) -> False
, \(_ :: B) -> False
, \(_ :: C) -> False
, \(_ :: D) -> False
, \(_ :: E) -> True
, \(_ :: F) -> False
))
]
class (Ord a, Num a) => OrdNum a
instance (Ord a, Num a) => OrdNum a