variant 1.0.1 → 1.0.2
raw patch · 12 files changed
+830/−79 lines, 12 filesdep ~base
Dependency ranges changed: base
Files
- changelog.md +6/−0
- src/bench/Main.hs +3/−3
- src/lib/Data/Variant.hs +499/−8
- src/lib/Data/Variant/ContFlow.hs +42/−1
- src/lib/Data/Variant/EADT/TH.hs +1/−1
- src/lib/Data/Variant/Excepts.hs +73/−0
- src/lib/Data/Variant/Syntax.hs +80/−1
- src/lib/Data/Variant/VEither.hs +81/−23
- src/lib/Data/Variant/VariantF.hs +14/−14
- src/tests/EADT.hs +2/−2
- src/tests/Variant.hs +22/−22
- variant.cabal +7/−4
+ changelog.md view
@@ -0,0 +1,6 @@+## 1.0.2++- Migrated documentation from the old independent user manual into Haddocks+- Fixed the benchmark+- Added GHC 9.12.4 to CI (9.14.1 is still failing due to dependencies not being+ available)
src/bench/Main.hs view
@@ -56,7 +56,7 @@ newtype Value a = Value a deriving newtype (NFData) newtype VariantNode a- = VariantNode (V '[Value a, Plus (VariantNode a), Minus (VariantNode a)])+ = VariantNode (V [Value a, Plus (VariantNode a), Minus (VariantNode a)]) deriving newtype instance (NFData a) => NFData (VariantNode a) @@ -83,10 +83,10 @@ let evalEnv n = do tree1 <- generate (resize n (arbitrary :: Gen (Node Int)))- let tree2 = nodeToVariantNode tree1+ let !tree2 = force (nodeToVariantNode tree1) return (n,tree1,tree2) - evalTest (n,tree1,tree2) = bgroup ("Tree Eval at size=" ++ show n)+ evalTest ~(n,tree1,tree2) = bgroup ("Tree Eval at size=" ++ show n) [ bench "ADT" $ whnf evalNode tree1 , bench "Variant ADT - V" $ whnf evalVariantNode tree2 , bench "Variant ADT - Safe match" $ whnf evalVariantNodeSafe tree2
src/lib/Data/Variant.hs view
@@ -17,7 +17,498 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} --- | Open sum type+{- | Open sum type++'V' (for Variant) is a sum type, i.e. a wrapper for a value which can be of+different types. For instance in the following code @x@ is a variant whose value+can be an @Int@, a @Float@ or a @String@:++> import Data.Variant+>+> x :: V [Int,Float,String]++We use a type-level list of types to statically constrain the possible value+types. Compared to usual sum types (e.g. @Either Int Float@) it allows us to+have variants which can contain any number of types and to manipulate+(extend\/filter\/etc.) the list in a type-safe way and without requiring new data+types.++__See also__++* "Data.Variant.VEither" is a variant biased towards the first type in the+ list, just like @Either a b@ is biased towards the second type (@b@), allowing+ instances such as @instance Functor (VEither a)@ which we do not have for 'V'.++* "Data.Variant.Excepts" is a multi-exception monad transformer wrapping+ 'Data.Variant.VEither.VEither'.++* "Data.Variant.EADT" supports recursive sum types based on Variant (Extensible+ ADTs).++== Why Variant?++In the functional programming world we use algebraic data types (ADT), more+specifically sum types, to indicate that a value can be of two or more different+types:++> x,y :: Either String Int+> x = Left "yo"+> y = Right 10++What if we want to support more than two types?++__Solution 1: sum types__++We could use different sum types with different constructors for each arity+(number of different types that the value can have).++> data SumOf3 a b c = S3_0 a | S3_1 b | S3_2 c+> data SumOf4 a b c d = S4_0 a | S4_1 b | S4_2 c | S4_3 d++But it is quite hard to work with that many different types and constructors as+we cannot easily define generic functions working on different sum types without+a combinatorial explosion.++__Solution 2: recursive ADT__++Instead of adding new sum types we can use a nest of @Either@:++> type SumOf3 a b c = Either a (Either b c)+> type SumOf4 a b c d = Either a (Either b (Either c d))++Or more generically:++> data Union (as :: [Type]) where+> Union :: Either (Union as) a -> Union (a : as)++This time we can define generic functions without risking a combinatorial+explosion. The drawback however is that we have changed the representation:+instead of @tag + value@ where @tag@ is in the range [0,arity-1] we have a+nest of @tag + (tag + (... (tag + value)))@ where @tag@ is in the range+[0,1]. It is both inefficient in space and in time (accessing the tag value is+in O(arity)).++__Solution 3: variant__++'V' gets the best of both approaches: it has the generic interface of+the \"recursive ADT\" solution and the efficient representation of the \"sum types\"+solution.++> data Variant (types :: [Type]) = Variant {-# UNPACK #-} !Word Any+>+> type role Variant representational++The efficient representation is ensured by the definition of the 'V'+datatype: an unpacked @Word@ for the tag and a \"pointer\" to the value.++The phantom type list @types@ contains the list of possible types for the value.+The tag value is used as an index into this list to know the effective type of the+value.++== Creating Variant values++The easiest way to create a variant value is to use the 'V' pattern synonym:++> x,y :: V [String,Int]+> x = V "test"+> y = V @Int 10++Note: for now the compiler cannot use the variant value type list to infer the+type of the variant value! In the previous example we have to specify the @Int@+type. Even if it is clear (for us) that it is the obvious unique possibility, it+is ambiguous for the compiler.++We can also explicitly create a variant by specifying the index (starting from+0) of the value type with 'toVariantAt':++> x :: V [Int,String,Float]+> x = toVariantAt @2 5.0++It is especially useful if for some reason we want to have the same type more+than once in the variant value type list:++> y :: V [Int,Int,String,Int,Float]+> y = toVariantAt @1 5++== Pattern matching++=== Direct pattern matching with V++Matching a variant value can be done with the 'V' pattern synonym too:++> f :: V [String,Int] -> String+> f = \case+> V s -> "Found string: " ++ s+> V (i :: Int) -> "Found int: " ++ show i+> _ -> undefined++Note: for now the compiler cannot use the variant value type list to infer that+the pattern-match is complete. Hence we need the wildcard match to avoid a warning.++See "Data.Variant.ContFlow" for safe alternatives that do not require a wildcard+match and that provide better type inference.++__Basic errors__++If you try to set or match a value type that is not valid, you get a compile-time+error:++> x :: V [String,Int]+> x = V @Float 10+>+> -- error: `Float' is not a member of [String, Int]++=== Safe pattern matching with continuations++See "Data.Variant.ContFlow" for safe pattern matching using multi-continuations+('>:>' and '>%:>') that ensure completeness at compile time.++== Operations by index++We can retrieve values by index with 'fromVariantAt':++> x :: V [Int,String,Float]+> x = toVariantAt @2 5.0+>+> > fromVariantAt @0 x+> Nothing+> > fromVariantAt @1 x+> Nothing+> > fromVariantAt @2 x+> Just 5.0++== Generic variant functions (variant-polymorphic functions)++=== Splitting variants++We can chose to handle only a subset of the possible value types of a Variant+by using 'splitVariant'. This is very useful when your variant is open (e.g. an+exception type) and you want to perform an action for some particular types+while ignoring the others (e.g. passing the unhandled exceptions to the caller).++For instance in the following example we only handle @Int@ and @Float@+values. The other ones are considered as left-overs:++> printNum v = case splitVariant @[Float,Int] v of+> Right v -> v >%:>+> ( \f -> putStrLn ("Found float: " ++ show (f :: Float))+> , \i -> putStrLn ("Found int: " ++ show (i :: Int))+> )+> Left leftovers -> putStrLn "Not a supported number!"++Note that the @printNum@ function above is generic and can be applied to any+Variant type.++=== Membership constraints: '(:<)', '(:<<)', '(:<?)' #membership++The @c :< cs@ constraint statically ensures that the type @c@ is in the @cs@+type list and that we can set and match it in a variant with type @V cs@. For+example:++> newtype Error = Error String+>+> showError :: (Error :< cs) => V cs -> String+> showError = \case+> V (Error s) -> "Found error: " ++ s+> _ -> "Not an Error!"++Note that to shorten a list of constraints such as @(A :< xs, B :< xs, C :< xs)@+you can use the '(:<<)' operator: @[A,B,C] :<< xs@.++The @c :< cs@ constraint statically ensures that the type @c@ is in the @cs@+type list. However in some cases we want to write generic functions that work on+variants even if they cannot contain the given type.++The '(:<?)' constraint and the 'VMaybe' pattern can be used for this:++> showErrorMaybe :: (Error :<? cs) => V cs -> String+> showErrorMaybe = \case+> VMaybe (Error s) -> "Found error: " ++ s+> _ -> "Not an Error!"++=== Shrinking variants with 'popVariant'++A very common use of variants is to pattern match on a specific value type they+can contain and to get a new variant containing the left-over value types. This+is done with 'popVariant' or 'popVariantMaybe' and the 'Remove' type family.+For example:++> filterError :: Error :<? cs => V cs -> V (Remove Error cs)+> filterError v = case popVariantMaybe v of+> Right (Error s) -> error ("Found error: " ++ s)+> Left v' -> v' -- left-over variant!++Notice how an @Error@ value cannot be present anymore in the variant type+returned by @filterError@ and how this function is generic as it supports any+variant as an input.++== Conversions++=== Singleton conversion++We can easily convert between a variant with a single value type and this value+type with 'variantToValue' and 'variantFromValue':++> intV :: V [Int]+> intV = V @Int 10+>+> > variantToValue intV+> 10+>+> > :t variantFromValue "Test"+> variantFromValue "Test" :: V [String]++=== Either conversion++'variantFromEither' and 'variantToEither' can be used to convert between a+variant of arity 2 and the @Either@ data type:++> eith :: Either Int String+> eith = Left 10+>+> > :t variantFromEither eith+> variantFromEither eith :: V [String, Int]+>+> x,y :: V [String,Int]+> x = V "test"+> y = V @Int 10+>+> > variantToEither x+> Right "test"+>+> > variantToEither y+> Left 10++== Extending the list of supported types++We can extend the value types of a variant by appending or prepending a list of+types with 'appendVariant' and 'prependVariant':++> x :: V [String,Int]+> x = V "test"+>+> data A = A+> data B = B+>+> px = prependVariant @[A,B] x+> ax = appendVariant @[A,B] x+>+> > :t ax+> ax :: V [String, Int, A, B]+>+> > :t px+> px :: V [A, B, String, Int]++Appending and prepending are very cheap operations: appending just messes with+types and performs nothing at runtime; prepending only increases the tag value+at runtime by a constant number.++=== Variant lifting (extending and reordering)++We can extend and reorder the value types of a variant with 'liftVariant':++> x :: V [String,Int]+> x = V "test"+>+> -- adding Double and Float, and reordering+> y :: V [Double,Int,Float,String]+> y = liftVariant x++You can use the 'LiftVariant' constraint to write generic code and to ensure+that the type list @is@ is a subset of @os@:++> liftX :: (LiftVariant is (Double : Float : is))+> => V is -> V (Double : Float : is)+> liftX = liftVariant+>+> > :t liftX x+> liftX x :: V [Double, Float, String, Int]++== Removing duplicates (nub)++If the list of types of a variant contains the same type more than once, we can+decide to only keep one of them with 'nubVariant':++> > z = nubVariant (V "test" :: V [String,Int,Double,Float,Double,String])+> > :t z+> z :: V [String, Int, Double, Float]++== Flattening nested variants++If the value types of a variant are themselves variants, you can flatten them+with 'flattenVariant':++> x :: V [String,Int]+> x = V "test"+>+> nest :: V [ V [String,Int], V [Float,Double]]+> nest = V x+>+> > :t flattenVariant nest+> flattenVariant nest :: V [String, Int, Float, Double]++== Joining variants of functors\/monads++We can transform a variant of functor values (e.g., @V [m a, m b, m c]@) into+a single functor value (e.g., @m (V [a,b,c])@) with 'joinVariant':++> fs0,fs1,fs2 :: V [ Maybe Int, Maybe String, Maybe Double]+> fs0 = V @(Maybe Int) (Just 10)+> fs1 = V (Just "Test")+> fs2 = V @(Maybe Double) Nothing+>+> > joinVariant @Maybe fs0+> Just (V @Int 10)+>+> > joinVariant @Maybe fs1+> Just (V @[Char] "Test")+>+> > joinVariant @Maybe fs2+> Nothing++It also works with @IO@ for example:++> ms0,ms1 :: V [ IO Int, IO String, IO Double]+> ms0 = V @(IO Int) (printRet 10)+> ms1 = V (printRet "Test")+>+> > joinVariant @IO ms0+> 10+> V @Int 10+>+> > :t joinVariant @IO ms0+> joinVariant @IO ms0 :: IO (V [Int, String, Double])++Writing generic code requires the use of the 'JoinVariant' constraint and+the resulting list of value types can be obtained with the 'ExtractM' type+family.++With @IO@ it is possible to use 'joinVariantUnsafe' which does not require the+type application and does not use the 'JoinVariant' type-class. However some+other functor types are not supported (e.g., @Maybe@) and using+'joinVariantUnsafe' with them makes the program crash at runtime.++== Combining two variants (product)++We can combine two variants into a single variant containing a tuple with+'productVariant':++> fl :: V [Float,Double]+> fl = V @Float 5.0+>+> d :: V [Int,Word]+> d = V @Word 10+>+> dfl = productVariant d fl+>+> > dfl+> V @(Word,Float) (10,5.0)+>+> > :t dfl+> dfl :: V [(Int, Float), (Int, Double), (Word, Float), (Word, Double)]++== Converting variants to tuples\/HList++We can convert a Variant into a tuple of 'Maybe's with 'variantToTuple':++> w :: V [String,Int,Double,Maybe Int]+> w = V @Double 1.0+>+> > variantToTuple w+> (Nothing,Nothing,Just 1.0,Nothing)++And similarly into an HList (heterogeneous list) with 'variantToHList':++> > variantToHList w+> H[Nothing,Nothing,Just 1.0,Nothing]++== Mapping++=== By type++We can easily apply a function @f :: A -> B@ to a variant so that its value+type @A@ is replaced with @B@. If the value in the variant has type @A@, then+@f@ is applied to it to get the new value. Example:++> x,y :: V [String,Int]+> x = V "test"+> y = V @Int 10+>+> > mapVariant ((+5) :: Int -> Int) x+> V @String "test"+>+> > mapVariant ((+5) :: Int -> Int) y+> V @Int 15++Note that the resulting variant may contain the same type more than once. To+avoid this, we can either use 'nubVariant' or directly use 'mapNubVariant':++> > :t mapVariant (length :: String -> Int) x+> mapVariant (length :: String -> Int) x :: V [Int, Int]+>+> > :t mapNubVariant (length :: String -> Int) x+> mapNubVariant (length :: String -> Int) x :: V [Int]+>+> > mapNubVariant (length :: String -> Int) x+> V @Int 4++=== By index++If we know the index of the value type we want to map, we can use+'mapVariantAt'. Example:++> x,y :: V [String,Int]+> x = V "test"+> y = V @Int 10+>+> > mapVariantAt @0 length x+> V @Int 4+>+> > mapVariantAt @0 length y+> V @Int 10+>+> > mapVariantAt @1 (+5) x+> V @[Char] "test"+>+> > mapVariantAt @1 (+5) y+> V @Int 15++Note that the compiler uses the type of the element whose index is given as+first argument to infer the type of the functions, hence we do not need type+ascriptions.++We can use 'mapVariantAtM' to perform an applicative (or monadic) update.++=== First matching type++A variant can have the same type more than once in its value type list.+'mapVariant' updates all the matching types in the list but sometimes that is+not what we want. We can use 'mapVariantAt' if we know the index of the type we+want to update. We can also use 'mapVariantFirst' to update only the first+matching type:++> vv :: V [Int,Int,Int]+> vv = toVariantAt @1 5+>+> > r0 = mapVariant (show :: Int -> String) vv+> > r1 = mapVariantFirst (show :: Int -> String) vv+>+> > :t r0+> r0 :: V [String,String,String]+>+> > :t r1+> r1 :: V [String, Int, Int]+>+> > r0+> V @[Char] "5"+>+> > r1+> V @Int 5++We can also apply an applicative (or monadic) function with+'mapVariantFirstM'.++-} module Data.Variant ( V (..) , variantIndex@@ -216,7 +707,7 @@ -- | Haskell code corresponding to a Variant -- -- >>> showsVariant 0 (V @Double 5.0 :: V [Int,String,Double]) ""--- "V @Double 5.0 :: V '[Int, [Char], Double]"+-- "V @Double 5.0 :: V [Int, [Char], Double]" showsVariant :: ( Typeable xs , ShowTypeList (V xs)@@ -238,7 +729,7 @@ -- | Show instance ----- >>> show (V @Int 10 :: V '[Int,String,Double])+-- >>> show (V @Int 10 :: V [Int,String,Double]) -- "10" instance ( Show x@@ -252,7 +743,7 @@ -- | Show a list of ShowS showList__ :: [ShowS] -> ShowS showList__ [] s = "'[]" ++ s-showList__ (x:xs) s = '\'' : '[' : x (showl xs)+showList__ (x:xs) s = '[' : x (showl xs) where showl [] = ']' : s showl (y:ys) = ',' : ' ' : y (showl ys)@@ -294,7 +785,7 @@ -- | Get variant size ----- >>> let x = V "Test" :: V '[Int,String,Double]+-- >>> let x = V "Test" :: V [Int,String,Double] -- >>> variantSize x -- 3 -- >>> let y = toVariantAt @0 10 :: V [Int,String,Double,Int]@@ -545,7 +1036,7 @@ -- | Bimap Variant head and tail ----- >>> let f = mapVariantHeadTail (+5) (appendVariant @'[Double,Char])+-- >>> let f = mapVariantHeadTail (+5) (appendVariant @[Double,Char]) -- >>> f (V @Int 10 :: V [Int,Word,Float]) -- 15 --@@ -701,7 +1192,7 @@ -- | Pick the first matching type of a Variant ----- >>> let x = toVariantAt @2 10 :: V '[Int,String,Int]+-- >>> let x = toVariantAt @2 10 :: V [Int,String,Int] -- >>> fromVariantFirst @Int x -- Nothing --@@ -872,7 +1363,7 @@ -- -- >>> newtype Odd = Odd Int deriving (Show) -- >>> newtype Even = Even Int deriving (Show)--- >>> let f x = if even x then V (Even x) else V (Odd x) :: V '[Odd, Even]+-- >>> let f x = if even x then V (Even x) else V (Odd x) :: V [Odd, Even] -- >>> foldMapVariantAt @1 f (V @Int 10 :: V [Float,Int,Double]) -- Even 10 --
src/lib/Data/Variant/ContFlow.hs view
@@ -8,7 +8,48 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE BangPatterns #-} --- | Continuation based control-flow+{- | Continuation-based control-flow++This module provides safe pattern matching on 'Data.Variant.V' values using+multi-continuations. Instead of pattern matching with the @V@ pattern (which+the compiler cannot check for completeness), we can provide a function per+constructor as in a pattern-match.++== Safe pattern matching with ordered continuations ('>:>')++With multi-continuations we can transform a variant @V [A,B,C]@ into a+function whose type is @(A -> r, B -> r, C -> r) -> r@. Hence the compiler+will ensure that we provide the correct number of alternatives in the+continuation tuple.++Applying a multi-continuation to a Variant is done with '>:>':++> import Data.Variant.ContFlow+>+> printV :: V [String,Int,Float] -> IO ()+> printV v = v >:>+> ( \s -> putStrLn ("Found string: " ++ s)+> , \i -> putStrLn ("Found int: " ++ show i)+> , \f -> putStrLn ("Found float: " ++ show f)+> )++== Safe pattern matching with unordered continuations ('>%:>')++By using the '>%:>' operator instead of '>:>', we can provide continuations in+any order as long as an alternative for each constructor is provided.++The types must be unambiguous as the Variant constructor types cannot be used to+infer the continuation types (as is done with '>:>'). Hence the type+ascriptions in the following example:++> printU :: V [String,Int,Float] -> IO ()+> printU v = v >%:>+> ( \f -> putStrLn ("Found float: " ++ show (f :: Float))+> , \s -> putStrLn ("Found string: " ++ s)+> , \i -> putStrLn ("Found int: " ++ show (i :: Int))+> )++-} module Data.Variant.ContFlow ( ContFlow (..) , ContTuple
src/lib/Data/Variant/EADT/TH.hs view
@@ -150,7 +150,7 @@ conTyp = getConTyp tys - -- [* -> *]+ -- [Type -> Type] tyToTyList = AppT ListT (AppT (AppT ArrowT StarT) StarT) -- retrieve functor var in "e"
src/lib/Data/Variant/Excepts.hs view
@@ -14,6 +14,79 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{- | Multi-exception monad transformer++Just like @ExceptT e m a@ from the @transformers@ package wraps an @Either e a@+value, 'Excepts' wraps a 'VEither' value (see "Data.Variant.VEither") and+provides standard do-notation for computations that can fail with multiple+error types.++== Example++> import Data.Variant.Excepts+>+> import Prelude hiding (head,lookup)+> import qualified Prelude+> import Text.Read+>+> data ParseError = ParseError deriving Show+>+> parse :: String -> Excepts [ParseError] IO Integer+> parse s = case readMaybe s of+> Just i -> pure i+> Nothing -> throwE ParseError+>+>+> data HeadError = ListWasEmpty deriving Show+>+> head :: [a] -> Excepts [HeadError] IO a+> head [] = throwE ListWasEmpty+> head (x:_) = pure x+>+> data LookupError k = KeyWasNotPresent k deriving Show+>+> lookup :: Eq k => k -> [(k,v)] -> Excepts [LookupError k] IO v+> lookup k vs = case Prelude.lookup k vs of+> Just v -> pure v+> Nothing -> throwE (KeyWasNotPresent k)+>+>+> foo :: String -> Excepts [ParseError, LookupError Char, HeadError] IO Integer+> foo str = do+> c <- liftE $ head str+> r <- liftE $ lookup c codeMap+> liftE $ parse (r ++ tail str)+>+> where+> codeMap :: [(Char, String)]+> codeMap = [ ('x', "0x")+> , ('d', "")+> ]++Test:++> > runE (foo "d10")+> VRight 10+>+> > runE (foo "x10")+> VRight 16+>+> > runE (foo "u10")+> VLeft KeyWasNotPresent 'u'+>+> > runE (foo "")+> VLeft ListWasEmpty+>+> > runE (foo "d10X")+> VLeft ParseError++Exceptions can be caught with 'catchE':++> > runE (foo "" `catchE` (\ListWasEmpty -> successE 42)+> > :: Excepts [ParseError,LookupError Char] IO Integer)+> VRight 42++-} module Data.Variant.Excepts ( Excepts (..) , runE
src/lib/Data/Variant/Syntax.hs view
@@ -3,7 +3,86 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} --- | Rebindable syntax for Variant+{- | Rebindable syntax for Variant++This module provides @RebindableSyntax@-based do-notation for 'V'. We+recommend using 'Data.Variant.VEither' or "Data.Variant.Excepts" instead, which+provide proper 'Monad' instances without requiring @RebindableSyntax@.++== Do-notation with Variants++We can use do-notation with 'V' as we would with other sum types such as+'Maybe' or 'Either'. However, as we cannot have a 'Monad' instance for 'V', we+rely on the @RebindableSyntax@ extension to mimic it.++The leftmost type is extracted from the Variant with @>>=@ (or @x \<-+myVariant@ with do-notation syntax). Variant types are concatenated on the+left.++Function @foo@ in the following example composes functions returning Variants+by using do-notation:++> {-# LANGUAGE TypeApplications #-}+> {-# LANGUAGE RebindableSyntax #-}+>+> import Data.Variant+> import Data.Variant.Syntax+>+> import Prelude hiding (head,lookup,(>>=),(>>),return)+> import qualified Prelude+> import Text.Read+>+> foo :: String -> V [Integer, ParseError, LookupError Char, HeadError]+> foo str = do+> c <- head str+> r <- lookup c codeMap+> parse (r ++ tail str)+>+> where+> codeMap :: [(Char, String)]+> codeMap = [ ('x', "0x")+> , ('d', "")+> ]+>+>+> data ParseError = ParseError deriving Show+>+> parse :: String -> V [Integer,ParseError]+> parse s = case readMaybe s of+> Just i -> V @Integer i+> Nothing -> V ParseError+>+> data HeadError = ListWasEmpty deriving Show+>+> head :: [a] -> V [a,HeadError]+> head [] = toVariantAt @1 ListWasEmpty+> head (x:_) = toVariantAt @0 x+>+> data LookupError k = KeyWasNotPresent k deriving Show+>+> lookup :: Eq k => k -> [(k,v)] -> V [v,LookupError k]+> lookup k vs = case Prelude.lookup k vs of+> Just v -> toVariantAt @0 v+> Nothing -> toVariantAt @1 (KeyWasNotPresent k)++Test:++> > foo "d10"+> V @Integer 10+>+> > foo "x10"+> V @Integer 16+>+> > foo "u10"+> V @(LookupError Char) (KeyWasNotPresent 'u')+>+> > foo ""+> V @HeadError ListWasEmpty+>+> > foo "d10X"+> V @ParseError ParseError++-} module Data.Variant.Syntax ( (>>=) , (>>)
src/lib/Data/Variant/VEither.hs view
@@ -20,10 +20,68 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} --- | Variant biased towards one type------ This allows definition of common type classes (Functor, etc.) that can't be--- provided for Variant+{- | Variant biased towards one type++Variants have types like @V [W,X,Y,Z]@. This is great when all the inner types+play the same role. However in some cases we want one type to be the main one+and the other ones to be secondaries.++For instance we could have @V [Result,ErrorA,ErrorB,ErrorC]@ to represent the+result of a function. In this case, the first type is the main one and it would+be great to be able to define the common type-classes ('Functor', 'Monad',+etc.) so that we have easy access to it.++'VEither' is a 'V' wrapper that does exactly this:++> newtype VEither es a = VEither (V (a : es))++It is isomorphic to @Either (V es) a@. The difference is in the runtime+representation: @VEither es a@ has one less indirection than @Either (V es) a@+(it uses only one tag value).++== Pattern matching (VRight and VLeft)++'VEither' values can be created and matched on with the 'VRight' and 'VLeft'+patterns (just as if we had the @Either (V es) a@ type).++> >>> VRight True :: VEither [String,Int] Bool+> VRight True+>+> >>> VLeft (V "failed" :: V [String,Int]) :: VEither [String,Int] Bool+> VLeft "failed"++== Common instances++The main advantage of @VEither es a@ over @V (a ': es)@ is that we can define+instances for common type-classes such as 'Functor', 'Applicative', 'Monad',+'Foldable', etc.:++> > let x = VRight True :: VEither [Int,Float] Bool+> > fmap (\b -> if b then "Success" else "Failure") x+> VRight "Success"+>+> > let x = VRight True :: VEither [Int,Float] Bool+> > let y = VRight False :: VEither [Int,Float] Bool+> > (&&) \<$> x \<*> y+> VRight False+>+> > let x = VRight True :: VEither [Int,Float] Bool+> > let f v = VRight (not v) :: VEither [Int,Float] Bool+> > x >>= f+> VRight False+>+> > let x = VRight True :: VEither [Int,Float] Bool+> > let y = VLeft (V "failed" :: V [String,Int]) :: VEither [String,Int] Bool+> > forM_ x print+> True+> > forM_ y print++== See also++* "Data.Variant.Excepts" — multi-exception monad transformer wrapping 'VEither'+* "Data.Variant" — the underlying 'V' type++-} module Data.Variant.VEither ( VEither , pattern VLeft@@ -68,7 +126,7 @@ -- | Left value ----- >>> VLeft (V "failed" :: V '[String,Int]) :: VEither '[String,Int] Bool+-- >>> VLeft (V "failed" :: V [String,Int]) :: VEither [String,Int] Bool -- VLeft "failed" -- pattern VLeft :: forall x xs. V xs -> VEither xs x@@ -78,7 +136,7 @@ -- | Right value ----- >>> VRight True :: VEither '[String,Int] Bool+-- >>> VRight True :: VEither [String,Int] Bool -- VRight True pattern VRight :: forall x xs. x -> VEither xs x pattern VRight x <- ((popVariantHead . veitherToVariant) -> Right x)@@ -93,10 +151,10 @@ -- | Check VEithers for equality ----- >>> let a = VRight "Foo" :: VEither '[Int,Double] String--- >>> let b = VRight "Foo" :: VEither '[Int,Double] String--- >>> let c = VRight "Bar" :: VEither '[Int,Double] String--- >>> let d = VLeft (V (1::Int) :: V '[Int, Double]) :: VEither '[Int,Double] String+-- >>> let a = VRight "Foo" :: VEither [Int,Double] String+-- >>> let b = VRight "Foo" :: VEither [Int,Double] String+-- >>> let c = VRight "Bar" :: VEither [Int,Double] String+-- >>> let d = VLeft (V (1::Int) :: V [Int, Double]) :: VEither [Int,Double] String -- >>> a == b -- True -- >>> a == c@@ -113,8 +171,8 @@ -- | Compare VEithers ----- >>> let a = VRight "Foo" :: VEither '[Int,Double] String--- >>> let b = VRight "Bar" :: VEither '[Int,Double] String+-- >>> let a = VRight "Foo" :: VEither [Int,Double] String+-- >>> let b = VRight "Bar" :: VEither [Int,Double] String -- >>> a < b -- False -- >>> a > b@@ -140,7 +198,7 @@ -- | Convert a Variant into a VEither ----- >>> let x = V "Test" :: V '[Int,String,Double]+-- >>> let x = V "Test" :: V [Int,String,Double] -- >>> veitherFromVariant x -- VLeft "Test" --@@ -150,7 +208,7 @@ -- | Convert a VEither into a Variant ----- >>> let x = VRight True :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool -- >>> veitherToVariant x -- True --@@ -160,7 +218,7 @@ -- | Convert a VEither into an Either ----- >>> let x = VRight True :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool -- >>> veitherToEither x -- Right True --@@ -181,7 +239,7 @@ -- | Bimap for VEither ----- >>> let x = VRight True :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool -- >>> veitherBimap id not x -- VRight False --@@ -229,7 +287,7 @@ -- | Functor instance for VEither ----- >>> let x = VRight True :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool -- >>> fmap (\b -> if b then "Success" else "Failure") x -- VRight "Success" --@@ -239,8 +297,8 @@ -- | Applicative instance for VEither ----- >>> let x = VRight True :: VEither '[Int,Float] Bool--- >>> let y = VRight False :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool+-- >>> let y = VRight False :: VEither [Int,Float] Bool -- >>> (&&) <$> x <*> y -- VRight False -- >>> (||) <$> x <*> y@@ -255,8 +313,8 @@ -- | Monad instance for VEither ----- >>> let x = VRight True :: VEither '[Int,Float] Bool--- >>> let f v = VRight (not v) :: VEither '[Int,Float] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool+-- >>> let f v = VRight (not v) :: VEither [Int,Float] Bool -- >>> x >>= f -- VRight False --@@ -266,8 +324,8 @@ -- | Foldable instance for VEither ----- >>> let x = VRight True :: VEither '[Int,Float] Bool--- >>> let y = VLeft (V "failed" :: V '[String,Int]) :: VEither '[String,Int] Bool+-- >>> let x = VRight True :: VEither [Int,Float] Bool+-- >>> let y = VLeft (V "failed" :: V [String,Int]) :: VEither [String,Int] Bool -- >>> forM_ x print -- True -- >>> forM_ y print
src/lib/Data/Variant/VariantF.hs view
@@ -76,7 +76,7 @@ -- >>> -- >>> data ConsF a e = ConsF a e deriving (Eq,Ord,Show,Functor) -- >>> data NilF e = NilF deriving (Eq,Ord,Show,Functor)--- >>> type ListF a = VariantF '[NilF,ConsF a]+-- >>> type ListF a = VariantF [NilF,ConsF a] -- >>> -- >>> instance Eq a => Eq1 (ConsF a) where liftEq cmp (ConsF a e1) (ConsF b e2) = a == b && cmp e1 e2 -- >>> instance Eq1 NilF where liftEq _ _ _ = True@@ -102,7 +102,7 @@ -- | Apply its first argument to every element of the 2nd arg list ----- > ApplyAll e '[f,g,h] ==> '[f e, g e, h e]+-- > ApplyAll e [f,g,h] ==> [f e, g e, h e] -- type family ApplyAll (e :: t) (xs :: [t -> k]) :: [k] where ApplyAll e '[] = '[]@@ -112,9 +112,9 @@ -- | Eq instance for VariantF ----- >>> let a = FV (ConsF 'a' "Test") :: VariantF '[ConsF Char,NilF] String--- >>> let a' = FV (ConsF 'a' "XXX") :: VariantF '[ConsF Char,NilF] String--- >>> let b = FV (ConsF 'b' "Test") :: VariantF '[ConsF Char,NilF] String+-- >>> let a = FV (ConsF 'a' "Test") :: VariantF [ConsF Char,NilF] String+-- >>> let a' = FV (ConsF 'a' "XXX") :: VariantF [ConsF Char,NilF] String+-- >>> let b = FV (ConsF 'b' "Test") :: VariantF [ConsF Char,NilF] String -- >>> a == a -- True -- >>> a == a'@@ -122,12 +122,12 @@ -- >>> a == b -- False ----- >>> let c = FV (ConsF 'c' b) :: VariantF '[ConsF Char,NilF] (VariantF '[ConsF Char, NilF] String)+-- >>> let c = FV (ConsF 'c' b) :: VariantF [ConsF Char,NilF] (VariantF [ConsF Char, NilF] String) -- >>> c == c -- True ----- >>> let n1 = FV (NilF :: NilF ()) :: VariantF '[ConsF Char,NilF] ()--- >>> let n2 = FV (NilF :: NilF ()) :: VariantF '[ConsF Char,NilF] ()+-- >>> let n1 = FV (NilF :: NilF ()) :: VariantF [ConsF Char,NilF] ()+-- >>> let n2 = FV (NilF :: NilF ()) :: VariantF [ConsF Char,NilF] () -- >>> n1 == n2 -- True --@@ -141,9 +141,9 @@ -- | Ord instance for VariantF ----- >>> let a = FV (ConsF 'a' "Test") :: VariantF '[ConsF Char,NilF] String--- >>> let a' = FV (ConsF 'a' "XXX") :: VariantF '[ConsF Char,NilF] String--- >>> let b = FV (ConsF 'b' "Test") :: VariantF '[ConsF Char,NilF] String+-- >>> let a = FV (ConsF 'a' "Test") :: VariantF [ConsF Char,NilF] String+-- >>> let a' = FV (ConsF 'a' "XXX") :: VariantF [ConsF Char,NilF] String+-- >>> let b = FV (ConsF 'b' "Test") :: VariantF [ConsF Char,NilF] String -- >>> compare a a -- EQ -- >>> compare a a'@@ -203,8 +203,8 @@ -- | Show instance for VariantF ----- >>> let a = FV (ConsF 'a' "Test") :: VariantF '[ConsF Char,NilF] String--- >>> let b = FV (NilF :: NilF String) :: VariantF '[ConsF Char,NilF] String+-- >>> let a = FV (ConsF 'a' "Test") :: VariantF [ConsF Char,NilF] String+-- >>> let b = FV (NilF :: NilF String) :: VariantF [ConsF Char,NilF] String -- >>> print a -- ConsF 'a' "Test" -- >>> print b@@ -229,7 +229,7 @@ -- | Pattern-match in a VariantF ----- >>> FV (NilF :: NilF String) :: VariantF '[ConsF Char,NilF] String+-- >>> FV (NilF :: NilF String) :: VariantF [ConsF Char,NilF] String -- NilF pattern FV :: forall c cs e. c :< (ApplyAll e cs) => c -> VariantF cs e pattern FV x = VariantF (V x)
src/tests/EADT.hs view
@@ -35,8 +35,8 @@ eadtPattern 'NilF "Nil" eadtInfixPattern 'ConsF ":->" -type ListF a = VariantF '[NilF, ConsF a]-type List a = EADT '[NilF, ConsF a]+type ListF a = VariantF [NilF, ConsF a]+type List a = EADT [NilF, ConsF a] instance Eq a => Eq1 (ConsF a) where liftEq cmp (ConsF a e1) (ConsF b e2) = a == b && cmp e1 e2
src/tests/Variant.hs view
@@ -26,8 +26,8 @@ data E = E deriving (Show,Eq) data F = F deriving (Show,Eq) -type ABC = V '[A,B,C]-type DEF = V '[D,E,F]+type ABC = V [A,B,C]+type DEF = V [D,E,F] b :: ABC b = toVariantAt @1 B@@ -60,7 +60,7 @@ 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 "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@@ -74,35 +74,35 @@ , 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 "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 "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 "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 "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)+ (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]) >::>+ (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
variant.cabal view
@@ -1,23 +1,26 @@ cabal-version: 2.4 name: variant-version: 1.0.1+version: 1.0.2 synopsis: Variant and EADT license: BSD-3-Clause license-file: LICENSE author: Sylvain Henry maintainer: sylvain@haskus.fr homepage: https://www.haskus.org-copyright: Sylvain Henry 2024+copyright: Sylvain Henry 2026 category: System build-type: Simple description: Variant (extensible sum type) and EADT (extensible recursive sum type) datatypes.+extra-doc-files:+ changelog.md + source-repository head type: git- location: git://github.com/haskus/variant.git+ location: https://github.com/haskus/variant.git flag unliftio Description: Enable MonadUnliftIO instance@@ -42,7 +45,7 @@ other-modules: build-depends: - base >= 4.9 && < 5.0+ base >= 4.9 && < 5 , transformers , deepseq , exceptions >= 0.9