-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | Variant and EADT
--
-- Variant (extensible sum type) and EADT (extensible recursive sum type)
-- datatypes.
@package variant
@version 1.0
-- | Functor and recursion schemes
--
-- Simple API is intended to be easier to understand (e.g. they don't use
-- xxmorphism and xxxalgebra jargon but tree-traversal-like terms).
module Data.Variant.Functor
type BottomUpT a f = f a -> a
-- | Bottom-up traversal (catamorphism)
bottomUp :: Recursive t => (Base t a -> a) -> t -> a
type BottomUpOrigT t a f = f (t, a) -> a
-- | Bottom-up traversal with original value (paramorphism)
bottomUpOrig :: Recursive t => (Base t (t, a) -> a) -> t -> a
type TopDownStopT a f = f a -> Either (f a) a
-- | Perform a top-down traversal
--
-- Right: stop the traversal ("right" value obtained) Left: continue the
-- traversal recursively on the new value
topDownStop :: (Recursive t, Corecursive t) => (Base t t -> Either (Base t t) t) -> t -> t
-- | A recursive datatype which can be rolled up one recursion layer at a
-- time.
--
-- For example, a value of type ListF a [a] can be rolled
-- up into a [a]. This [a] can then be used in a
-- Cons to construct another ListF a [a], which
-- can be rolled up as well, and so on.
--
-- Typically, Corecursive types also have a Recursive
-- instance, in which case embed and project are inverses.
class Functor Base t => Corecursive t
-- | Roll up a single recursion layer.
--
--
-- >>> embed (Cons 1 [2,3])
-- [1,2,3]
--
embed :: Corecursive t => Base t t -> t
-- | An alias for unfold.
ana :: Corecursive t => (a -> Base t a) -> a -> t
apo :: Corecursive t => (a -> Base t (Either t a)) -> a -> t
-- | Fokkinga's postpromorphism
postpro :: (Corecursive t, Recursive t) => (forall b. () => Base t b -> Base t b) -> (a -> Base t a) -> a -> t
-- | A generalized postpromorphism
gpostpro :: (Corecursive t, Recursive t, Monad m) => (forall b. () => m (Base t b) -> Base t (m b)) -> (forall c. () => Base t c -> Base t c) -> (a -> Base t (m a)) -> a -> t
-- | A recursive datatype which can be unrolled one recursion layer at a
-- time.
--
-- For example, a value of type [a] can be unrolled into a
-- ListF a [a]. If that unrolled value is a Cons,
-- it contains another [a] which can be unrolled as well, and so
-- on.
--
-- Typically, Recursive types also have a Corecursive
-- instance, in which case project and embed are inverses.
class Functor Base t => Recursive t
-- | Unroll a single recursion layer.
--
--
-- >>> project [1,2,3]
-- Cons 1 [2,3]
--
project :: Recursive t => t -> Base t t
-- | An alias for fold.
--
-- fold is by far the most common recursion-scheme, because
-- working one layer at a time is the most common strategy for writing a
-- recursive function. But there are also other, rarer strategies.
-- Researchers have given names to the most common strategies, and their
-- name for fold is "catamorphism". They also give its Base t
-- a -> a argument a special name, "(Base t)-algebra".
-- More generally, a function of the form f a -> a is called
-- an "f-algebra".
--
-- The names might seem intimidating at first, but using the standard
-- nomenclature has benefits. If you program with others, it can be
-- useful to have a shared vocabulary to refer to those recursion
-- patterns. For example, you can discuss which type of recursion is the
-- most appropriate for the problem at hand. Names can also help to
-- structure your thoughts while writing recursive functions.
--
-- The rest of this module lists a few of the other recursion-schemes
-- which are common enough to have a name. In this section, we restrict
-- our attention to those which fold a recursive structure down to a
-- value. In the examples all functions will be of type Tree Int
-- -> String.
cata :: Recursive t => (Base t a -> a) -> t -> a
-- | A variant of cata in which recursive positions also include the
-- original sub-tree, in addition to the result of folding that sub-tree.
--
-- For our running example, let's add a number to each node indicating
-- how many children are below it. To do so, we will need to count those
-- nodes from the original sub-tree.
--
--
-- >>> :{
-- let pprint4 :: Tree Int -> String
-- pprint4 = flip runReader 0 . para go
-- where
-- go :: TreeF Int (Tree Int, Reader Int String)
-- -> Reader Int String
-- go (NodeF i trss) = do
-- -- trss :: [(Tree Int, Reader Int String)]
-- -- ts :: [Tree Int]
-- -- rss :: [Reader Int String]
-- -- ss :: [String]
-- let (ts, rss) = unzip trss
-- let count = sum $ fmap length ts
-- ss <- local (+ 2) $ sequence rss
-- indent <- ask
-- let s = replicate indent ' '
-- ++ "* " ++ show i
-- ++ " (" ++ show count ++ ")"
-- pure $ intercalate "\n" (s : ss)
-- :}
--
--
--
-- >>> putStrLn $ pprint4 myTree
-- * 0 (7)
-- * 1 (0)
-- * 2 (0)
-- * 3 (4)
-- * 31 (3)
-- * 311 (2)
-- * 3111 (0)
-- * 3112 (0)
--
--
-- One common use for para is to construct a new tree which reuses
-- most of the sub-trees from the original. In the following example, we
-- insert a new node under the leftmost leaf. This requires allocating
-- new nodes along a path from the root to that leaf, while keeping every
-- other sub-tree untouched.
--
--
-- >>> :{
-- let insertLeftmost :: Int -> Tree Int -> Tree Int
-- insertLeftmost new = para go
-- where
-- go :: TreeF Int (Tree Int, Tree Int)
-- -> Tree Int
-- go (NodeF i []) = Node i [Node new []]
-- go (NodeF i ((_orig, recur) : tts))
-- -- tts :: [(Tree Int, Tree Int)]
-- = let (origs, _recurs) = unzip tts
-- in Node i (recur : origs)
-- :}
--
--
--
-- >>> putStrLn $ pprint4 $ insertLeftmost 999 myTree
-- * 0 (8)
-- * 1 (1)
-- * 999 (0)
-- * 2 (0)
-- * 3 (4)
-- * 31 (3)
-- * 311 (2)
-- * 3111 (0)
-- * 3112 (0)
--
para :: Recursive t => (Base t (t, a) -> a) -> t -> a
gpara :: (Recursive t, Corecursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> (Base t (EnvT t w a) -> a) -> t -> a
-- | Fokkinga's prepromorphism
prepro :: (Recursive t, Corecursive t) => (forall b. () => Base t b -> Base t b) -> (Base t a -> a) -> t -> a
gprepro :: (Recursive t, Corecursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> (forall c. () => Base t c -> Base t c) -> (Base t (w a) -> a) -> t -> a
-- | Obtain the base functor for a recursive datatype.
--
-- The core idea of this library is that instead of writing recursive
-- functions on a recursive datatype, we prefer to write non-recursive
-- functions on a related, non-recursive datatype we call the "base
-- functor".
--
-- For example, [a] is a recursive type, and its corresponding
-- base functor is ListF a:
--
--
-- data ListF a b = Nil | Cons a b
-- type instance Base [a] = ListF a
--
--
-- The relationship between those two types is that if we replace
-- b with ListF a, we obtain a type which is
-- isomorphic to [a].
type family Base t :: Type -> Type
-- | Folds a recursive type down to a value, one layer at a time.
--
--
-- >>> :{
-- let mySum :: [Int] -> Int
-- mySum = fold $ \case
-- Nil -> 0
-- Cons x sumXs -> x + sumXs
-- :}
--
--
--
-- >>> mySum [10,11,12]
-- 33
--
--
-- In our running example, one layer consists of an Int and a list
-- of recursive positions. In Tree Int, those recursive
-- positions contain sub-trees of type Tree Int. Since we are
-- working one layer at a time, the Base t a -> a function is
-- not given a Tree Int, but a TreeF Int String. That
-- is, each recursive position contains the String resulting from
-- recursively folding the corresponding sub-tree.
--
--
-- >>> :{
-- let pprint1 :: Tree Int -> String
-- pprint1 = fold $ \case
-- NodeF i [] -> show i
-- NodeF i ss -> show i ++ ": [" ++ intercalate ", " ss ++ "]"
-- :}
--
--
--
-- >>> putStrLn $ pprint1 myTree
-- 0: [1, 2, 3: [31: [311: [3111, 3112]]]]
--
--
-- More generally, the t argument is the recursive value, the
-- a is the final result, and the Base t a -> a
-- function explains how to reduce a single layer full of recursive
-- results down to a result.
fold :: Recursive t => (Base t a -> a) -> t -> a
-- | A generalization of unfoldr. The starting seed is expanded
-- into a base functor whose recursive positions contain more seeds,
-- which are themselves expanded, and so on.
--
--
-- >>> :{
--
-- >>> let ourEnumFromTo :: Int -> Int -> [Int]
--
-- >>> ourEnumFromTo lo hi = ana go lo where
--
-- >>> go i = if i > hi then Nil else Cons i (i + 1)
--
-- >>> :}
--
--
--
-- >>> ourEnumFromTo 1 4
-- [1,2,3,4]
--
unfold :: Corecursive t => (a -> Base t a) -> a -> t
-- | A generalized anamorphism
gunfold :: (Corecursive t, Monad m) => (forall b. () => m (Base t b) -> Base t (m b)) -> (a -> Base t (m a)) -> a -> t
-- | An optimized version of fold f . unfold g.
--
-- Useful when your recursion structure is shaped like a particular
-- recursive datatype, but you're neither consuming nor producing that
-- recursive datatype. For example, the recursion structure of quick sort
-- is a binary tree, but its input and output is a list, not a binary
-- tree.
--
--
-- >>> data BinTreeF a b = Tip | Branch b a b deriving (Functor)
--
--
--
-- >>> :{
--
-- >>> let quicksort :: Ord a => [a] -> [a]
--
-- >>> quicksort = refold merge split where
--
-- >>> split [] = Tip
--
-- >>> split (x:xs) = let (l, r) = partition (<x) xs in Branch l x r
--
-- >>>
--
-- >>> merge Tip = []
--
-- >>> merge (Branch l x r) = l ++ [x] ++ r
--
-- >>> :}
--
--
--
-- >>> quicksort [1,5,2,8,4,9,8]
-- [1,2,4,5,8,8,9]
--
refold :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
-- | An alias for refold.
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
distPara :: Corecursive t => Base t (t, a) -> (t, Base t a)
distParaT :: (Corecursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> Base t (EnvT t w a) -> EnvT t w (Base t a)
-- | A generalized catamorphism
gcata :: (Recursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> (Base t (w a) -> a) -> t -> a
-- | A generalized catamorphism
gfold :: (Recursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> (Base t (w a) -> a) -> t -> a
distCata :: Functor f => f (Identity a) -> Identity (f a)
-- | A generalized anamorphism
gana :: (Corecursive t, Monad m) => (forall b. () => m (Base t b) -> Base t (m b)) -> (a -> Base t (m a)) -> a -> t
distAna :: Functor f => Identity (f a) -> f (Identity a)
-- | A generalized hylomorphism
ghylo :: (Comonad w, Functor f, Monad m) => (forall c. () => f (w c) -> w (f c)) -> (forall d. () => m (f d) -> f (m d)) -> (f (w b) -> b) -> (a -> f (m a)) -> a -> b
-- | A generalized hylomorphism
grefold :: (Comonad w, Functor f, Monad m) => (forall c. () => f (w c) -> w (f c)) -> (forall d. () => m (f d) -> f (m d)) -> (f (w b) -> b) -> (a -> f (m a)) -> a -> b
futu :: Corecursive t => (a -> Base t (Free (Base t) a)) -> a -> t
gfutu :: (Corecursive t, Functor m, Monad m) => (forall b. () => m (Base t b) -> Base t (m b)) -> (a -> Base t (FreeT (Base t) m a)) -> a -> t
distFutu :: Functor f => Free f (f a) -> f (Free f a)
distGFutu :: (Functor f, Functor h) => (forall b. () => h (f b) -> f (h b)) -> FreeT f h (f a) -> f (FreeT f h a)
-- | Convert from one recursive type to another.
--
--
-- >>> showTree $ hoist (\(NonEmptyF h t) -> NodeF [h] (maybeToList t)) ( 'a' :| "bcd")
-- (a (b (c d)))
--
hoist :: (Recursive s, Corecursive t) => (forall a. () => Base s a -> Base t a) -> s -> t
-- | Convert from one recursive representation to another.
--
--
-- >>> refix ["foo", "bar"] :: Fix (ListF String)
-- Fix (Cons "foo" (Fix (Cons "bar" (Fix Nil))))
--
refix :: (Recursive s, Corecursive t, Base s ~ Base t) => s -> t
zygo :: Recursive t => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a
distZygo :: Functor f => (f b -> b) -> f (b, a) -> (b, f a)
gzygo :: (Recursive t, Comonad w) => (Base t b -> b) -> (forall c. () => Base t (w c) -> w (Base t c)) -> (Base t (EnvT b w a) -> a) -> t -> a
distZygoT :: (Functor f, Comonad w) => (f b -> b) -> (forall c. () => f (w c) -> w (f c)) -> f (EnvT b w a) -> EnvT b w (f a)
gapo :: Corecursive t => (b -> Base t b) -> (a -> Base t (Either b a)) -> a -> t
distApo :: Recursive t => Either t (Base t a) -> Base t (Either t a)
distGApo :: Functor f => (b -> f b) -> Either b (f a) -> f (Either b a)
distGApoT :: (Functor f, Functor m) => (b -> f b) -> (forall c. () => m (f c) -> f (m c)) -> ExceptT b m (f a) -> f (ExceptT b m a)
-- | A variant of cata which includes the results of all the
-- descendents, not just the direct children.
--
-- Like para, a sub-tree is provided for each recursive position.
-- Each node in that sub-tree is annotated with the result for that
-- descendent. The Cofree type is used to add those annotations.
--
-- For our running example, let's recreate GitHub's directory compression
-- algorithm. Notice that in the repository for this package,
-- GitHub displays src/Data/Functor, not src:
--
--
-- GitHub does this because src only contains one entry:
-- Data. Similarly, Data only contains one entry:
-- Functor. Functor contains several entries, so the
-- compression stops there. This helps users get to the interesting
-- folders more quickly.
--
-- Before we use histo, we need to define a helper function
-- rollup. It collects nodes until it reaches a node which
-- doesn't have exactly one child. It also returns the labels of that
-- node's children.
--
--
-- >>> :{
-- let rollup :: [Cofree (TreeF node) label]
-- -> ([node], [label])
-- rollup [_ :< NodeF node cofrees] =
-- let (nodes, label) = rollup cofrees
-- in (node : nodes, label)
-- rollup cofrees =
-- ([], fmap extract cofrees)
-- :}
--
--
--
-- >>> let foobar xs = 1 :< NodeF "foo" [2 :< NodeF "bar" xs]
--
-- >>> rollup [foobar []]
-- (["foo","bar"],[])
--
-- >>> rollup [foobar [3 :< NodeF "baz" [], 4 :< NodeF "quux" []]]
-- (["foo","bar"],[3,4])
--
--
-- The value foobar [] can be interpreted as the tree NodeF
-- "foo" [NodeF "bar" []], plus two annotations. The "foo"
-- node is annotated with 1, while the "bar" node is
-- annotated with 2. When we call histo below, those
-- annotations are recursive results of type Int -> String.
--
--
-- >>> :{
-- let pprint5 :: Tree Int -> String
-- pprint5 t = histo go t 0
-- where
-- go :: TreeF Int (Cofree (TreeF Int) (Int -> String))
-- -> Int -> String
-- go (NodeF node cofrees) indent
-- -- cofrees :: [Cofree (TreeF Int) (Int -> String)]
-- -- fs :: [Int -> String]
-- = let indent' = indent + 2
-- (nodes, fs) = rollup cofrees
-- ss = map (\f -> f indent') fs
-- s = replicate indent ' '
-- ++ "* " ++ intercalate " / " (fmap show (node : nodes))
-- in intercalate "\n" (s : ss)
-- :}
--
--
--
-- >>> putStrLn $ pprint5 myTree
-- * 0
-- * 1
-- * 2
-- * 3 / 31 / 311
-- * 3111
-- * 3112
--
--
-- One common use for histo is to cache the value computed for
-- smaller sub-trees. In the Fibonacci example below, the recursive type
-- is Natural, which is isomorphic to [()]. Our annotated
-- sub-tree is thus isomorphic to a list of annotations. In our case,
-- each annotation is the result which was computed for a smaller number.
-- We thus have access to a list which caches all the Fibonacci numbers
-- we have computed so far.
--
--
-- >>> :{
-- let fib :: Natural -> Integer
-- fib = histo go
-- where
-- go :: Maybe (Cofree Maybe Integer) -> Integer
-- go Nothing = 1
-- go (Just (_ :< Nothing)) = 1
-- go (Just (fibNMinus1 :< Just (fibNMinus2 :< _)))
-- = fibNMinus1 + fibNMinus2
-- :}
--
--
--
-- >>> fmap fib [0..10]
-- [1,1,2,3,5,8,13,21,34,55,89]
--
--
-- In general, Cofree f a can be thought of as a cache that has
-- the same shape as the recursive structure which was given as input.
histo :: Recursive t => (Base t (Cofree (Base t) a) -> a) -> t -> a
ghisto :: (Recursive t, Comonad w) => (forall b. () => Base t (w b) -> w (Base t b)) -> (Base t (CofreeT (Base t) w a) -> a) -> t -> a
distHisto :: Functor f => f (Cofree f a) -> Cofree f (f a)
distGHisto :: (Functor f, Functor h) => (forall b. () => f (h b) -> h (f b)) -> f (CofreeT f h a) -> CofreeT f h (f a)
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
gchrono :: (Functor f, Functor w, Functor m, Comonad w, Monad m) => (forall c. () => f (w c) -> w (f c)) -> (forall c. () => m (f c) -> f (m c)) -> (f (CofreeT f w b) -> b) -> (a -> f (FreeT f m a)) -> a -> b
-- | Mendler-style iteration
mcata :: (forall y. () => (y -> c) -> f y -> c) -> Fix f -> c
-- | Mendler-style recursion
mpara :: (forall y. () => (y -> c) -> (y -> Fix f) -> f y -> c) -> Fix f -> c
-- | Mendler-style semi-mutual recursion
mzygo :: (forall y. () => (y -> b) -> f y -> b) -> (forall y. () => (y -> c) -> (y -> b) -> f y -> c) -> Fix f -> c
-- | Mendler-style course-of-value iteration
mhisto :: (forall y. () => (y -> c) -> (y -> f y) -> f y -> c) -> Fix f -> c
-- | Mendler-style coiteration
mana :: (forall y. () => (x -> y) -> x -> f y) -> x -> Fix f
-- | Mendler-style corecursion
mapo :: (forall y. () => (Fix f -> y) -> (x -> y) -> x -> f y) -> x -> Fix f
-- | Mendler-style course-of-values coiteration
mfutu :: (forall y. () => (f y -> y) -> (x -> y) -> x -> f y) -> x -> Fix f
-- | Elgot algebras
elgot :: Functor f => (f a -> a) -> (b -> Either a (f b)) -> b -> a
-- | Elgot coalgebras:
-- http://comonad.com/reader/2008/elgot-coalgebras/
coelgot :: Functor f => ((a, f b) -> b) -> (a -> f a) -> a -> b
-- | Zygohistomorphic prepromorphisms:
--
-- A corrected and modernized version of
-- http://www.haskell.org/haskellwiki/Zygohistomorphic_prepromorphisms
zygoHistoPrepro :: (Corecursive t, Recursive t) => (Base t b -> b) -> (forall c. () => Base t c -> Base t c) -> (Base t (EnvT b (Cofree (Base t)) a) -> a) -> t -> a
-- | A specialization of cata for effectful folds.
--
-- cataA is the same as cata, but with a more specialized
-- type. The only reason it exists is to make it easier to discover how
-- to use this library with effects.
--
-- For our running example, let's improve the output format of our
-- pretty-printer by using indentation. To do so, we will need to keep
-- track of the current indentation level. We will do so using a
-- Reader Int effect. Our recursive positions will thus contain
-- Reader Int String actions, not Strings. This means
-- we need to run those actions in order to get the results.
--
--
-- >>> :{
-- let pprint2 :: Tree Int -> String
-- pprint2 = flip runReader 0 . cataA go
-- where
-- go :: TreeF Int (Reader Int String)
-- -> Reader Int String
-- go (NodeF i rss) = do
-- -- rss :: [Reader Int String]
-- -- ss :: [String]
-- ss <- local (+ 2) $ sequence rss
-- indent <- ask
-- let s = replicate indent ' ' ++ "* " ++ show i
-- pure $ intercalate "\n" (s : ss)
-- :}
--
--
--
-- >>> putStrLn $ pprint2 myTree
-- * 0
-- * 1
-- * 2
-- * 3
-- * 31
-- * 311
-- * 3111
-- * 3112
--
--
-- The fact that the recursive positions contain Reader actions
-- instead of Strings gives us some flexibility. Here, we are able
-- to increase the indentation by running those actions inside a
-- local block. More generally, we can control the order of
-- their side-effects, interleave them with other effects, etc.
--
-- A similar technique is to specialize cata so that the result is
-- a function. This makes it possible for data to flow down in addition
-- to up. In this modified version of our running example, the
-- indentation level flows down from the root to the leaves, while the
-- resulting strings flow up from the leaves to the root.
--
--
-- >>> :{
-- let pprint3 :: Tree Int -> String
-- pprint3 t = cataA go t 0
-- where
-- go :: TreeF Int (Int -> String)
-- -> Int -> String
-- go (NodeF i fs) indent
-- -- fs :: [Int -> String]
-- = let indent' = indent + 2
-- ss = map (\f -> f indent') fs
-- s = replicate indent ' ' ++ "* " ++ show i
-- in intercalate "\n" (s : ss)
-- :}
--
--
--
-- >>> putStrLn $ pprint3 myTree
-- * 0
-- * 1
-- * 2
-- * 3
-- * 31
-- * 311
-- * 3111
-- * 3112
--
cataA :: Recursive t => (Base t (f a) -> f a) -> t -> f a
-- | An effectful version of hoist.
--
-- Properties:
--
--
-- transverse sequenceA = pure
--
--
-- Examples:
--
-- The weird type of first argument allows user to decide an order of
-- sequencing:
--
--
-- >>> transverse (\x -> print (void x) *> sequence x) "foo" :: IO String
-- Cons 'f' ()
-- Cons 'o' ()
-- Cons 'o' ()
-- Nil
-- "foo"
--
--
--
-- >>> transverse (\x -> sequence x <* print (void x)) "foo" :: IO String
-- Nil
-- Cons 'o' ()
-- Cons 'o' ()
-- Cons 'f' ()
-- "foo"
--
transverse :: (Recursive s, Corecursive t, Functor f) => (forall a. () => Base s (f a) -> f (Base t a)) -> s -> f t
-- | A coeffectful version of hoist.
--
-- Properties:
--
--
-- cotransverse distAna = runIdentity
--
--
-- Examples:
--
-- Stateful transformations:
--
--
-- >>> :{
-- cotransverse
-- (\(u, b) -> case b of
-- Nil -> Nil
-- Cons x a -> Cons (if u then toUpper x else x) (not u, a))
-- (True, "foobar") :: String
-- :}
-- "FoObAr"
--
--
-- We can implement a variant of zipWith
--
--
-- >>> data Pair a = Pair a a deriving Functor
--
--
--
-- >>> :{
-- let zipWith' :: forall a b. (a -> a -> b) -> [a] -> [a] -> [b]
-- zipWith' f xs ys = cotransverse g (Pair xs ys) where
-- g :: Pair (ListF a c) -> ListF b (Pair c)
-- g (Pair Nil _) = Nil
-- g (Pair _ Nil) = Nil
-- g (Pair (Cons x a) (Cons y b)) = Cons (f x y) (Pair a b)
-- :}
--
--
--
-- >>> zipWith' (*) [1,2,3] [4,5,6]
-- [4,10,18]
--
--
--
-- >>> zipWith' (*) [1,2,3] [4,5,6,8]
-- [4,10,18]
--
--
--
-- >>> zipWith' (*) [1,2,3,3] [4,5,6]
-- [4,10,18]
--
cotransverse :: (Recursive s, Corecursive t, Functor f) => (forall a. () => f (Base s a) -> Base t (f a)) -> f s -> t
type Algebra f a = f a -> a
type CoAlgebra f a = a -> f a
type RAlgebra f t a = f (t, a) -> a
type RCoAlgebra f t a = a -> f (Either t a)
type f ~> g = forall a. f a -> g a
type NatM m f g = forall a. f a -> m (g a)
type family HBase (h :: k -> Type) :: (k -> Type) -> (k -> Type)
type HAlgebra h f = h f ~> f
type HAlgebraM m h f = NatM m (h f) f
type HGAlgebra w h a = h (w a) ~> a
type HGAlgebraM w m h a = NatM m (h (w a)) a
type HCoalgebra h f = f ~> h f
type HCoalgebraM m h f = NatM m f (h f)
type HGCoalgebra m h a = a ~> h (m a)
type HGCoalgebraM n m h a = NatM m a (h (n a))
class HFunctor (h :: (k -> Type) -> (k -> Type))
hfmap :: HFunctor h => (f ~> g) -> h f ~> h g
class HFunctor h => HFoldable (h :: (k -> Type) -> (k -> Type))
hfoldMap :: (HFoldable h, Monoid m) => (forall b. f b -> m) -> h f a -> m
class HFoldable h => HTraversable (h :: (k -> Type) -> (k -> Type))
htraverse :: (HTraversable h, Applicative e) => NatM e f g -> NatM e (h f) (h g)
class HFunctor (HBase h) => HRecursive (h :: k -> Type)
hproject :: HRecursive h => HCoalgebra (HBase h) h
hcata :: HRecursive h => HAlgebra (HBase h) f -> h ~> f
class HFunctor (HBase h) => HCorecursive (h :: k -> Type)
hembed :: HCorecursive h => HAlgebra (HBase h) h
hana :: HCorecursive h => HCoalgebra (HBase h) f -> f ~> h
hhylo :: HFunctor f => HAlgebra f b -> HCoalgebra f a -> a ~> b
hcataM :: (Monad m, HTraversable (HBase h), HRecursive h) => HAlgebraM m (HBase h) f -> h a -> m (f a)
hlambek :: (HRecursive h, HCorecursive h) => HCoalgebra (HBase h) h
hpara :: (HFunctor (HBase h), HRecursive h) => HGAlgebra (Product h) (HBase h) a -> h ~> a
hparaM :: (HTraversable (HBase h), HRecursive h, Monad m) => HGAlgebraM (Product h) m (HBase h) a -> NatM m h a
hanaM :: (Monad m, HTraversable (HBase h), HCorecursive h) => HCoalgebraM m (HBase h) f -> f a -> m (h a)
hcolambek :: HRecursive h => HCorecursive h => HAlgebra (HBase h) h
hapo :: HCorecursive h => HGCoalgebra (Sum h) (HBase h) a -> a ~> h
hapoM :: (HCorecursive h, HTraversable (HBase h), Monad m) => HGCoalgebraM (Sum h) m (HBase h) a -> NatM m a h
hhyloM :: (HTraversable t, Monad m) => HAlgebraM m t h -> HCoalgebraM m t f -> f a -> m (h a)
module Data.Variant.Types
-- | Get a Nat value
natValue :: forall (n :: Nat) a. (KnownNat n, Num a) => a
-- | Get a Nat value as a Word
natValue' :: forall (n :: Nat). KnownNat n => Word
-- | Indexed access into the list
type Index (n :: Nat) (l :: [k]) = Index' n l l
-- | Concat two type lists
type family Concat (xs :: [k]) (ys :: [k]) :: [k]
-- | Get list length
type family Length (xs :: [k]) :: Nat
-- | Product of two lists
type family Product (xs :: [Type]) (ys :: [Type]) :: [Type]
-- | Remove a in l
type family Remove (a :: k) (l :: [k]) :: [k]
-- | Keep only a single value of each type
type family Nub (l :: [k]) :: [k]
-- | Reverse a list
type family Reverse (l :: [k]) :: [k]
-- | Get the first index of a type
type IndexOf (x :: k) (xs :: [k]) = IndexOf' (MaybeIndexOf x xs) x xs
-- | Get the first index (starting from 1) of a type or 0 if none
type family MaybeIndexOf (a :: k) (l :: [k])
-- | Constraint: x member of xs
type family Member x xs :: Constraint
-- | Insert a list at n
type family InsertAt (n :: Nat) (l :: [k]) (l2 :: [k]) :: [k]
-- | replace l[n] with l2 (folded)
type family ReplaceAt (n :: Nat) (l :: [k]) (l2 :: [k]) :: [k]
-- | Get all the indexes of a type
type family IndexesOf (a :: k) (l :: [k]) :: [Nat]
-- | replace a type at offset n in l
type family ReplaceN (n :: Nat) (t :: k) (l :: [k]) :: [k]
-- | replace types at offsets ns in l
type family ReplaceNS (ns :: [Nat]) (t :: k) (l :: [k]) :: [k]
-- | Complement xs ys
type family Complement (xs :: [k]) (ys :: [k]) :: [k]
-- | Remove a type at index
type family RemoveAt (n :: Nat) (l :: [k]) :: [k]
-- | Remove a type at index (0 == don't remove)
type family RemoveAt1 (n :: Nat) (l :: [k]) :: [k]
-- | Tail of a list
type family Tail (xs :: [k]) :: [k]
-- | The kind of lifted constraints
type Constraint = CONSTRAINT LiftedRep
-- | Build a list of constraints e.g., ConstraintAll1 Eq '[A,B,C] ==>
-- (Eq A, Eq B, Eq C)
type family ConstraintAll1 (f :: k -> Constraint) (xs :: [k]) :: Constraint
-- | Tuple helpers
module Data.Variant.Tuple
-- | Uncurry3
uncurry3 :: (a -> b -> c -> r) -> (a, b, c) -> r
-- | Uncurry4
uncurry4 :: (a -> b -> c -> d -> r) -> (a, b, c, d) -> r
-- | Uncurry5
uncurry5 :: (a -> b -> c -> d -> e -> r) -> (a, b, c, d, e) -> r
-- | Uncurry6
uncurry6 :: (a -> b -> c -> d -> e -> f -> r) -> (a, b, c, d, e, f) -> r
-- | Uncurry7
uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> r) -> (a, b, c, d, e, f, g) -> r
-- | Take specialised for quadruple
take4 :: [a] -> (a, a, a, a)
-- | toList for quadruple
fromTuple4 :: (a, a, a, a) -> [a]
-- | Solo is the canonical lifted 1-tuple, just like (,)
-- is the canonical lifted 2-tuple (pair) and (,,) is the
-- canonical lifted 3-tuple (triple).
--
-- The most important feature of Solo is that it is possible to
-- force its "outside" (usually by pattern matching) without forcing its
-- "inside", because it is defined as a datatype rather than a newtype.
-- One situation where this can be useful is when writing a function to
-- extract a value from a data structure. Suppose you write an
-- implementation of arrays and offer only this function to index into
-- them:
--
--
-- index :: Array a -> Int -> a
--
--
-- Now imagine that someone wants to extract a value from an array and
-- store it in a lazy-valued finite map/dictionary:
--
--
-- insert "hello" (arr index 12) m
--
--
-- This can actually lead to a space leak. The value is not actually
-- extracted from the array until that value (now buried in a map) is
-- forced. That means the entire array may be kept live by just that
-- value! Often, the solution is to use a strict map, or to force the
-- value before storing it, but for some purposes that's undesirable.
--
-- One common solution is to include an indexing function that can
-- produce its result in an arbitrary Applicative context:
--
--
-- indexA :: Applicative f => Array a -> Int -> f a
--
--
-- When using indexA in a pure context, Solo
-- serves as a handy Applicative functor to hold the result. You
-- could write a non-leaky version of the above example thus:
--
--
-- case arr indexA 12 of
-- Solo a -> insert "hello" a m
--
--
-- While such simple extraction functions are the most common uses for
-- unary tuples, they can also be useful for fine-grained control of
-- strict-spined data structure traversals, and for unifying the
-- implementations of lazy and strict mapping functions.
data () => Solo a
MkSolo :: a -> Solo a
pattern Solo :: a -> Solo a
-- | Boxed tuple
--
-- TODO: put this family into GHC
type family Tuple xs = t | t -> xs
-- | Unboxed tuple
--
-- TODO: put this family into GHC
type family Tuple# xs = t | t -> xs
type family TypeReps xs
-- | Extract a tuple value statically
class ExtractTuple (n :: Nat) xs
-- | Extract a tuple value by type-level index
tupleN :: ExtractTuple n xs => Tuple xs -> Index n xs
-- | Create a Tuple
class TupleCon xs
-- | Create a Tuple
tupleCon :: TupleCon xs => TupleFun (Tuple xs) xs
-- | Get first element of the tuple
tupleHead :: forall xs. ExtractTuple 0 xs => Tuple xs -> Index 0 xs
class TupleTail ts ts' | ts -> ts'
tupleTail :: TupleTail ts ts' => ts -> ts'
class TupleCons t ts ts' | t ts -> ts'
tupleCons :: TupleCons t ts ts' => t -> ts -> ts'
-- | Reorder tuple elements
class ReorderTuple t1 t2
-- | Reorder tuple elements
tupleReorder :: ReorderTuple t1 t2 => t1 -> t2
instance Data.Variant.Tuple.ExtractTuple 0 '[a]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2, e3]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2, e3]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2, e3]
instance Data.Variant.Tuple.ExtractTuple 3 '[e0, e1, e2, e3]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4]
instance Data.Variant.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4]
instance Data.Variant.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 6 '[e0, e1, e2, e3, e4, e5, e6]
instance Data.Variant.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 6 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.ExtractTuple 7 '[e0, e1, e2, e3, e4, e5, e6, e7]
instance Data.Variant.Tuple.TupleCon '[]
instance Data.Variant.Tuple.TupleCon '[a]
instance Data.Variant.Tuple.TupleCon '[a, b]
instance Data.Variant.Tuple.TupleCon '[a, b, c]
instance Data.Variant.Tuple.TupleCon '[a, b, c, d]
instance Data.Variant.Tuple.TupleCon '[a, b, c, d, e]
instance Data.Variant.Tuple.TupleCon '[a, b, c, d, e, f]
instance Data.Variant.Tuple.ReorderTuple (Solo a) (Solo a)
instance Data.Variant.Tuple.ReorderTuple (a, b) (a, b)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (a, b, c)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d) (a, b, c, d)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (a, b, c, d, e)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (a, b, c, d, e, f)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g, h)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h, i)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i, j)
instance Data.Variant.Tuple.ReorderTuple (a, b) (b, a)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (a, c, b)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (b, a, c)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (b, c, a)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (c, a, b)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (c, b, a)
instance Data.Variant.Tuple.ReorderTuple (b, c, d) (x, y, z) => Data.Variant.Tuple.ReorderTuple (a, b, c, d) (a, x, y, z)
instance Data.Variant.Tuple.ReorderTuple (a, c, d) (x, y, z) => Data.Variant.Tuple.ReorderTuple (a, b, c, d) (x, b, y, z)
instance Data.Variant.Tuple.ReorderTuple (a, b, d) (x, y, z) => Data.Variant.Tuple.ReorderTuple (a, b, c, d) (x, y, c, z)
instance Data.Variant.Tuple.ReorderTuple (a, b, c) (x, y, z) => Data.Variant.Tuple.ReorderTuple (a, b, c, d) (x, y, z, d)
instance Data.Variant.Tuple.ReorderTuple (b, c, d, e) (x, y, z, w) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (a, x, y, z, w)
instance Data.Variant.Tuple.ReorderTuple (a, c, d, e) (x, y, z, w) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (x, b, y, z, w)
instance Data.Variant.Tuple.ReorderTuple (a, b, d, e) (x, y, z, w) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (x, y, c, z, w)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, e) (x, y, z, w) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, d, w)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d) (x, y, z, w) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, w, e)
instance Data.Variant.Tuple.ReorderTuple (b, c, d, e, f) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (a, x, y, z, w, v)
instance Data.Variant.Tuple.ReorderTuple (a, c, d, e, f) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, b, y, z, w, v)
instance Data.Variant.Tuple.ReorderTuple (a, b, d, e, f) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, c, z, w, v)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, e, f) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, d, w, v)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, f) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, e, v)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, w, v) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, v, f)
instance Data.Variant.Tuple.ReorderTuple (b, c, d, e, f, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (a, x, y, z, w, v, u)
instance Data.Variant.Tuple.ReorderTuple (a, c, d, e, f, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, b, y, z, w, v, u)
instance Data.Variant.Tuple.ReorderTuple (a, b, d, e, f, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, c, z, w, v, u)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, e, f, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, d, w, v, u)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, f, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, e, v, u)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, g) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, v, f, u)
instance Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, v, u) => Data.Variant.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, v, u, g)
instance Data.Variant.Tuple.TupleCons a (Solo b) (a, b)
instance Data.Variant.Tuple.TupleCons a (b, c) (a, b, c)
instance Data.Variant.Tuple.TupleCons a (b, c, d) (a, b, c, d)
instance Data.Variant.Tuple.TupleCons a (b, c, d, e) (a, b, c, d, e)
instance Data.Variant.Tuple.TupleCons a (b, c, d, e, f) (a, b, c, d, e, f)
instance Data.Variant.Tuple.TupleTail (a, b) (Solo b)
instance Data.Variant.Tuple.TupleTail (a, b, c) (b, c)
instance Data.Variant.Tuple.TupleTail (a, b, c, d) (b, c, d)
instance Data.Variant.Tuple.TupleTail (a, b, c, d, e) (b, c, d, e)
instance Data.Variant.Tuple.TupleTail (a, b, c, d, e, f) (b, c, d, e, f)
-- | Continuation based control-flow
module Data.Variant.ContFlow
-- | A continuation based control-flow
newtype ContFlow (xs :: [Type]) r
ContFlow :: (ContTuple xs r -> r) -> ContFlow (xs :: [Type]) r
-- | Convert a list of types into the actual data type representing the
-- continuations.
type family ContTuple (xs :: [Type]) r
-- | Bind a multi-continuable type to a tuple of continuations
(>:>) :: MultiCont a => a -> ContTuple (MultiContTypes a) r -> r
infixl 0 >:>
-- | Bind a single-continuable type to a 1-tuple of continuations
(>-:>) :: (MultiCont a, MultiContTypes a ~ '[b]) => a -> (b -> r) -> r
infixl 0 >-:>
-- | Bind a multi-continuable type to a tuple of continuations and reorder
-- fields if necessary
(>%:>) :: (MultiCont a, ReorderTuple ts (ContTuple (MultiContTypes a) r)) => a -> ts -> r
infixl 0 >%:>
-- | Bind a flow to a tuple of continuations
(>::>) :: ContFlow xs r -> ContTuple xs r -> r
infixl 0 >::>
-- | Bind a flow to a 1-tuple of continuations
(>:-:>) :: ContFlow '[a] r -> (a -> r) -> r
infixl 0 >:-:>
-- | Bind a flow to a tuple of continuations and reorder fields if
-- necessary
(>:%:>) :: forall ts xs r. ReorderTuple ts (ContTuple xs r) => ContFlow xs r -> ts -> r
infixl 0 >:%:>
type family ToMultiCont xs r
-- | A multi-continuable type
class MultiCont a where {
type MultiContTypes a :: [Type];
}
-- | Convert a data into a multi-continuation
toCont :: MultiCont a => a -> ContFlow (MultiContTypes a) r
-- | Convert a data into a multi-continuation (monadic)
toContM :: (MultiCont a, Monad m) => m a -> ContFlow (MultiContTypes a) (m r)
-- | Open sum type
module Data.Variant
-- | A variant contains a value whose type is at the given position in the
-- type list
data V (l :: [Type])
Variant :: {-# UNPACK #-} !Word -> Any -> V (l :: [Type])
-- | Get Variant index
--
--
-- >>> let x = V "Test" :: V [Int,String,Double]
--
-- >>> variantIndex x
-- 1
--
-- >>> let y = toVariantAt @0 10 :: V [Int,String,Double]
--
-- >>> variantIndex y
-- 0
--
variantIndex :: V a -> Word
-- | Get variant size
--
--
-- >>> let x = V "Test" :: V '[Int,String,Double]
--
-- >>> variantSize x
-- 3
--
-- >>> let y = toVariantAt @0 10 :: V [Int,String,Double,Int]
--
-- >>> variantSize y
-- 4
--
variantSize :: forall xs. KnownNat (Length xs) => V xs -> Word
-- | Pattern synonym for Variant
--
-- Usage: case v of V (x :: Int) -> ... V (x :: String) -> ...
pattern V :: forall c cs. c :< cs => c -> V cs
-- | Statically unchecked matching on a Variant
pattern VMaybe :: forall c cs. c : c -> V cs
-- | A value of type "x" can be extracted from (V xs)
type (:<) x xs = (Member x xs, x :x in xs, `x :< ys`
type family (:<<) xs ys :: Constraint
-- | A value of type "x" **might** be extracted from (V xs). We don't check
-- that "x" is in "xs".
type (:
-- >>> toVariantAt @1 10 :: V [Word,Int,Double]
-- 10
--
toVariantAt :: forall (n :: Nat) (l :: [Type]). KnownNat n => Index n l -> V l
-- | Set the first value
--
--
-- >>> toVariantHead 10 :: V [Int,Float,Word]
-- 10
--
toVariantHead :: forall x xs. x -> V (x ': xs)
-- | Set the tail
--
--
-- >>> let x = V @Int 10 :: V [Int,String,Float]
--
-- >>> let y = toVariantTail @Double x
--
-- >>> :t y
-- y :: V [Double, Int, String, Float]
--
toVariantTail :: forall x xs. V xs -> V (x ': xs)
-- | Try to get a value by index into the type list
--
--
-- >>> let x = V "Test" :: V [Int,String,Float]
--
-- >>> fromVariantAt @0 x
-- Nothing
--
-- >>> fromVariantAt @1 x
-- Just "Test"
--
-- >>> fromVariantAt @2 x
-- Nothing
--
fromVariantAt :: forall (n :: Nat) (l :: [Type]). KnownNat n => V l -> Maybe (Index n l)
-- | Try to get the first variant value
--
--
-- >>> let x = V "Test" :: V [Int,String,Float]
--
-- >>> fromVariantHead x
-- Nothing
--
-- >>> let y = V @Int 10 :: V [Int,String,Float]
--
-- >>> fromVariantHead y
-- Just 10
--
fromVariantHead :: V (x ': xs) -> Maybe x
-- | Pop a variant value by index, return either the value or the remaining
-- variant
--
--
-- >>> let x = V @Word 10 :: V [Int,Word,Float]
--
-- >>> popVariantAt @0 x
-- Left 10
--
-- >>> popVariantAt @1 x
-- Right 10
--
-- >>> popVariantAt @2 x
-- Left 10
--
popVariantAt :: forall (n :: Nat) l. KnownNat n => V l -> Either (V (RemoveAt n l)) (Index n l)
-- | Pop the head of a variant value
--
--
-- >>> let x = V @Word 10 :: V [Int,Word,Float]
--
-- >>> popVariantHead x
-- Left 10
--
--
--
-- >>> let y = V @Int 10 :: V [Int,Word,Float]
--
-- >>> popVariantHead y
-- Right 10
--
popVariantHead :: forall x xs. V (x ': xs) -> Either (V xs) x
-- | Update a single variant value by index
--
--
-- >>> import Data.Char (toUpper)
--
-- >>> let x = V @String "Test" :: V [Int,String,Float]
--
-- >>> mapVariantAt @1 (fmap toUpper) x
-- "TEST"
--
--
--
-- >>> mapVariantAt @0 (+1) x
-- "Test"
--
mapVariantAt :: forall (n :: Nat) a b l. (KnownNat n, a ~ Index n l) => (a -> b) -> V l -> V (ReplaceN n b l)
-- | Applicative update of a single variant value by index
--
-- Example with Maybe:
--
--
-- >>> let f s = if s == "Test" then Just (42 :: Word) else Nothing
--
-- >>> let x = V @String "Test" :: V [Int,String,Float]
--
-- >>> mapVariantAtM @1 f x
-- Just 42
--
--
--
-- >>> let y = V @String "NotTest" :: V [Int,String,Float]
--
-- >>> mapVariantAtM @1 f y
-- Nothing
--
--
-- Example with IO:
--
--
-- >>> v <- mapVariantAtM @0 print x
--
--
--
-- >>> :t v
-- v :: V [(), String, Float]
--
--
--
-- >>> v <- mapVariantAtM @1 print x
-- "Test"
--
--
--
-- >>> :t v
-- v :: V [Int, (), Float]
--
--
--
-- >>> v <- mapVariantAtM @2 print x
--
--
--
-- >>> :t v
-- v :: V [Int, [Char], ()]
--
mapVariantAtM :: forall (n :: Nat) a b l m. (KnownNat n, Applicative m, a ~ Index n l) => (a -> m b) -> V l -> m (V (ReplaceN n b l))
-- | Update a variant value with a variant and fold the result
--
--
-- >>> 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]
--
-- >>> foldMapVariantAt @1 f (V @Int 10 :: V [Float,Int,Double])
-- Even 10
--
--
--
-- >>> foldMapVariantAt @1 f (V @Float 0.5 :: V [Float,Int,Double])
-- 0.5
--
foldMapVariantAt :: forall (n :: Nat) l l2. (KnownNat n, KnownNat (Length l2)) => (Index n l -> V l2) -> V l -> V (ReplaceAt n l l2)
-- | Update a variant value with a variant and fold the result
foldMapVariantAtM :: forall (n :: Nat) m l l2. (KnownNat n, KnownNat (Length l2), Monad m) => (Index n l -> m (V l2)) -> V l -> m (V (ReplaceAt n l l2))
-- | Bind (>>=) for a Variant
bindVariant :: forall x xs ys. KnownNat (Length ys) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)
-- | Const bind (>>) for a Variant
constBindVariant :: forall xs ys. V xs -> V ys -> V (Concat ys xs)
-- | List-like catamorphism
--
--
-- >>> let f = variantHeadTail (\i -> "Found Int: " ++ show i) (const "Something else")
--
-- >>> f (V @String "Test" :: V [Int,String,Float])
-- "Something else"
--
--
--
-- >>> f (V @Int 10 :: V [Int,String,Float])
-- "Found Int: 10"
--
variantHeadTail :: (x -> u) -> (V xs -> u) -> V (x ': xs) -> u
-- | Bimap Variant head and tail
--
--
-- >>> let f = mapVariantHeadTail (+5) (appendVariant @'[Double,Char])
--
-- >>> f (V @Int 10 :: V [Int,Word,Float])
-- 15
--
--
--
-- >>> f (V @Word 20 :: V [Int,Word,Float])
-- 20
--
mapVariantHeadTail :: (x -> y) -> (V xs -> V ys) -> V (x ': xs) -> V (y ': ys)
-- | Put a value into a Variant
--
-- Use the first matching type index.
toVariant :: forall a l. a :< l => a -> V l
-- | Extract a type from a variant. Return either the value of this type or
-- the remaining variant
popVariant :: forall a xs. a :< xs => V xs -> Either (V (Remove a xs)) a
-- | Extract a type from a variant. Return either the value of this type or
-- the remaining variant
popVariantMaybe :: forall a xs. a : V xs -> Either (V (Remove a xs)) a
-- | Try to a get a value of a given type from a Variant
--
-- Equivalent to pattern V.
--
--
-- >>> let x = toVariantAt @2 10 :: V [Int,String,Int]
--
-- >>> fromVariant @Int x
-- Just 10
--
--
--
-- fromVariant @Double x
--
--
-- ... error: Double not found in list: [Int, String, Int] ...
fromVariant :: forall a xs. a :< xs => V xs -> Maybe a
-- | Try to a get a value of a given type from a Variant that may not even
-- support the given type.
--
--
-- >>> let x = V @Int 10 :: V [Int,String,Float]
--
-- >>> fromVariantMaybe @Int x
-- Just 10
--
-- >>> fromVariantMaybe @Double x
-- Nothing
--
fromVariantMaybe :: forall a xs. a : V xs -> Maybe a
-- | Pick the first matching type of a Variant
--
--
-- >>> let x = toVariantAt @2 10 :: V '[Int,String,Int]
--
-- >>> fromVariantFirst @Int x
-- Nothing
--
fromVariantFirst :: forall a l. Member a l => V l -> Maybe a
-- | Update the first matching variant value
--
--
-- >>> let x = toVariantAt @0 10 :: V [Int,String,Int]
--
-- >>> mapVariantFirst @Int (+32) x
-- 42
--
--
--
-- >>> let y = toVariantAt @2 10 :: V [Int,String,Int]
--
-- >>> mapVariantFirst @Int (+32) y
-- 10
--
mapVariantFirst :: forall a b n l. (Member a l, n ~ IndexOf a l) => (a -> b) -> V l -> V (ReplaceN n b l)
-- | Applicative update of the first matching variant value
--
-- Example with Maybe:
--
--
-- >>> let f s = if s == (42 :: Int) then Just "Yeah!" else Nothing
--
-- >>> mapVariantFirstM f (toVariantAt @0 42 :: V [Int,Float,Int])
-- Just "Yeah!"
--
--
--
-- >>> mapVariantFirstM f (toVariantAt @2 42 :: V [Int,Float,Int])
-- Just 42
--
--
--
-- >>> mapVariantFirstM f (toVariantAt @0 10 :: V [Int,Float,Int])
-- Nothing
--
--
--
-- >>> mapVariantFirstM f (toVariantAt @2 10 :: V [Int,Float,Int])
-- Just 10
--
--
-- Example with IO:
--
--
-- >>> mapVariantFirstM @Int print (toVariantAt @0 42 :: V [Int,Float,Int])
-- 42
-- ()
--
--
--
-- >>> mapVariantFirstM @Int print (toVariantAt @2 42 :: V [Int,Float,Int])
-- 42
--
mapVariantFirstM :: forall a b n l m. (Member a l, n ~ IndexOf a l, Applicative m) => (a -> m b) -> V l -> m (V (ReplaceN n b l))
-- | Map the matching types of a variant
--
--
-- >>> let add1 = mapVariant @Int (+1)
--
-- >>> add1 (toVariantAt @0 10 :: V [Int,Float,Int,Double])
-- 11
--
--
--
-- >>> add1 (toVariantAt @2 10 :: V [Int,Float,Int, Double])
-- 11
--
mapVariant :: forall a b cs. MapVariant a b cs => (a -> b) -> V cs -> V (ReplaceAll a b cs)
-- | Map the matching types of a variant and nub the result
--
--
-- >>> let add1 = mapNubVariant @Int (+1)
--
-- >>> add1 (toVariantAt @0 10 :: V [Int,Float,Int,Double])
-- 11
--
--
--
-- >>> add1 (toVariantAt @2 10 :: V [Int,Float,Int, Double])
-- 11
--
mapNubVariant :: forall a b cs ds rs. (MapVariant a b cs, ds ~ ReplaceNS (IndexesOf a cs) b cs, rs ~ Nub ds, LiftVariant ds rs) => (a -> b) -> V cs -> V rs
-- | Update a variant value with a variant and fold the result
foldMapVariantFirst :: forall a (n :: Nat) l l2. (KnownNat n, KnownNat (Length l2), n ~ IndexOf a l, a ~ Index n l) => (a -> V l2) -> V l -> V (ReplaceAt n l l2)
-- | Update a variant value with a variant and fold the result
foldMapVariantFirstM :: forall a (n :: Nat) l l2 m. (KnownNat n, KnownNat (Length l2), n ~ IndexOf a l, a ~ Index n l, Monad m) => (a -> m (V l2)) -> V l -> m (V (ReplaceAt n l l2))
-- | Update a variant value with a variant and fold the result
--
--
-- >>> 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]
--
-- >>> foldMapVariant @Int f (V @Int 10 :: V [Float,Int,Double])
-- Even 10
--
--
--
-- >>> foldMapVariant @Int f (V @Float 0.5 :: V [Float,Int,Double])
-- 0.5
--
foldMapVariant :: forall a cs ds i. (i ~ IndexOf a cs, a :< cs) => (a -> V ds) -> V cs -> V (InsertAt i (Remove a cs) ds)
-- | Constraint: x member of xs
type family Member x xs :: Constraint
-- | Remove a in l
type family Remove (a :: k) (l :: [k]) :: [k]
type ReplaceAll a b cs = ReplaceNS (IndexesOf a cs) b cs
type MapVariant a b cs = (MapVariantIndexes a b cs (IndexesOf a cs))
-- | Alter a variant. You need to specify the constraints required by the
-- modifying function.
--
-- Usage: alterVariant NoConstraint id v alterVariant Resizable
-- (resize 4) v
--
--
-- - - Multiple constraints: class (Ord a, Num a) => OrdNum a
-- instance (Ord a, Num a) => OrdNum a alterVariant @OrdNum foo v
--
alterVariant :: forall c (a :: [Type]). AlterVariant c a => (forall x. c x => x -> x) -> V a -> V a
-- | Traverse a variant. You need to specify the constraints required by
-- the modifying function.
traverseVariant :: forall c (a :: [Type]) m. (TraverseVariant c a m, Monad m) => (forall x. c x => x -> m x) -> V a -> m (V a)
-- | Traverse a variant. You need to specify the constraints required by
-- the modifying function.
traverseVariant_ :: forall c (a :: [Type]) m. (TraverseVariant c a m, Monad m) => (forall x. c x => x -> m ()) -> V a -> m ()
-- | Reduce a variant to a single value by using a class function. You need
-- to specify the constraints required by the modifying function.
--
--
-- >>> let v = V "Yes" :: V [String,Bool,Char]
--
-- >>> reduceVariant @Show show v
-- "\"Yes\""
--
--
--
-- >>> let n = V (10 :: Int) :: V [Int,Word,Integer]
--
-- >>> reduceVariant @Integral fromIntegral n :: Int
-- 10
--
reduceVariant :: forall c (a :: [Type]) r. ReduceVariant c a => (forall x. c x => x -> r) -> V a -> r
-- | Useful to specify a "Type -> Constraint" function returning an
-- empty constraint
class NoConstraint a
class AlterVariant c (b :: [Type])
class TraverseVariant c (b :: [Type]) m
class ReduceVariant c (b :: [Type])
-- | Extend a variant by appending other possible values
appendVariant :: forall (ys :: [Type]) (xs :: [Type]). V xs -> V (Concat xs ys)
-- | Extend a variant by prepending other possible values
prependVariant :: forall (ys :: [Type]) (xs :: [Type]). KnownNat (Length ys) => V xs -> V (Concat ys xs)
-- | Lift a variant into another
--
-- Set values to the first matching type
liftVariant :: forall ys xs. LiftVariant xs ys => V xs -> V ys
-- | Nub the type list
nubVariant :: LiftVariant xs (Nub xs) => V xs -> V (Nub xs)
-- | Product of two variants
productVariant :: forall xs ys. KnownNat (Length ys) => V xs -> V ys -> V (Product xs ys)
-- | Flatten variants in a variant
flattenVariant :: forall xs. Flattenable (V xs) (V (FlattenVariant xs)) => V xs -> V (FlattenVariant xs)
-- | Join on a variant
--
-- Transform a variant of applicatives as follow: f :: V [m a, m b, m c]
-- -> m (V [a,b,c]) f = joinVariant @m
joinVariant :: JoinVariant m xs => V xs -> m (V (ExtractM m xs))
-- | Join on a variant in an unsafe way.
--
-- Works with IO for example but not with Maybe.
joinVariantUnsafe :: forall m xs ys. (Functor m, ys ~ ExtractM m xs) => V xs -> m (V ys)
-- | Split a variant in two
splitVariant :: forall as xs. SplitVariant as (Complement xs as) xs => V xs -> Either (V (Complement xs as)) (V as)
-- | xs is liftable in ys
type LiftVariant xs ys = (LiftVariant' xs ys, xs :<< ys)
class Flattenable a rs
type family FlattenVariant (xs :: [Type]) :: [Type]
type family ExtractM m f
class JoinVariant m xs
class SplitVariant as rs xs
-- | Retrieve a single value
variantToValue :: V '[a] -> a
-- | Create a variant from a single value
variantFromValue :: a -> V '[a]
-- | Convert a variant of two values in a Either
variantToEither :: forall a b. V '[a, b] -> Either b a
-- | Lift an Either into a Variant (reversed order by convention)
variantFromEither :: Either a b -> V '[b, a]
class ContVariant xs
-- | Convert a variant into a multi-continuation
variantToCont :: ContVariant xs => V xs -> ContFlow xs r
-- | Convert a variant into a multi-continuation
variantToContM :: (ContVariant xs, Monad m) => m (V xs) -> ContFlow xs (m r)
-- | Convert a multi-continuation into a Variant
contToVariant :: ContVariant xs => ContFlow xs (V xs) -> V xs
-- | Convert a multi-continuation into a Variant
contToVariantM :: (ContVariant xs, Monad m) => ContFlow xs (m (V xs)) -> m (V xs)
-- | Silent pattern synonym for Variant
--
-- Usage: case v of VSilent (x :: Int) -> ... VSilent (x :: String)
-- -> ...
pattern VSilent :: forall c cs. (Member c cs, PopVariant c cs) => c -> V cs
liftVariant' :: LiftVariant' xs ys => V xs -> V ys
-- | Try to a get a value of a given type from a Variant (silent)
fromVariant' :: forall a xs. PopVariant a xs => V xs -> Maybe a
-- | Remove a type from a variant
popVariant' :: PopVariant a xs => V xs -> Either (V (Remove a xs)) a
-- | Put a value into a Variant (silent)
--
-- Use the first matching type index.
toVariant' :: forall a l. Member a l => a -> V l
-- | xs is liftable in ys
class LiftVariant' xs ys
class PopVariant a xs
-- | Put a value into a variant if possible
--
--
-- >>> toVariantMaybe "Test" :: Maybe (V [Int,Float])
-- Nothing
--
--
--
-- >>> toVariantMaybe "Test" :: Maybe (V [Int,Float,String])
-- Just "Test"
--
class ToVariantMaybe a xs
-- | Put a value into a Variant, when the Variant's row contains that type.
toVariantMaybe :: ToVariantMaybe a xs => a -> Maybe (V xs)
-- | Haskell code corresponding to a Variant
--
--
-- >>> showsVariant 0 (V @Double 5.0 :: V [Int,String,Double]) ""
-- "V @Double 5.0 :: V '[Int, [Char], Double]"
--
showsVariant :: (Typeable xs, ShowTypeList (V xs), ShowVariantValue (V xs)) => Int -> V xs -> ShowS
instance Data.Variant.ContVariant xs => Data.Variant.ContFlow.MultiCont (Data.Variant.V xs)
instance Data.Variant.ContVariant '[a]
instance Data.Variant.ContVariant '[a, b]
instance Data.Variant.ContVariant '[a, b, c]
instance Data.Variant.ContVariant '[a, b, c, d]
instance Data.Variant.ContVariant '[a, b, c, d, e]
instance Data.Variant.ContVariant '[a, b, c, d, e, f]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g, h]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g, h, i]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g, h, i, j]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g, h, i, j, k]
instance Data.Variant.ContVariant '[a, b, c, d, e, f, g, h, i, j, k, l]
instance Data.Variant.JoinVariant m '[]
instance (GHC.Base.Functor m, Data.Variant.ExtractM m (m a : xs) GHC.Types.~ (a : Data.Variant.ExtractM m xs), Data.Variant.JoinVariant m xs) => Data.Variant.JoinVariant m (m a : xs)
instance Data.Variant.Flattenable (Data.Variant.V '[]) rs
instance (Data.Variant.Flattenable (Data.Variant.V ys) (Data.Variant.V rs), GHC.TypeNats.KnownNat (Data.Variant.Types.Length xs)) => Data.Variant.Flattenable (Data.Variant.V (Data.Variant.V xs : ys)) (Data.Variant.V rs)
instance Data.Variant.LiftVariant' '[] ys
instance (Data.Variant.LiftVariant' xs ys, GHC.TypeNats.KnownNat (Data.Variant.Types.IndexOf x ys)) => Data.Variant.LiftVariant' (x : xs) ys
instance Data.Variant.ReduceVariant c '[]
instance (Data.Variant.ReduceVariant c xs, c x) => Data.Variant.ReduceVariant c (x : xs)
instance Data.Variant.TraverseVariant c '[] m
instance (Data.Variant.TraverseVariant c xs m, c x, GHC.Base.Monad m) => Data.Variant.TraverseVariant c (x : xs) m
instance Data.Variant.AlterVariant c '[]
instance (Data.Variant.AlterVariant c xs, c x) => Data.Variant.AlterVariant c (x : xs)
instance Data.Variant.NoConstraint a
instance Data.Variant.MapVariantIndexes a b '[] is
instance Data.Variant.MapVariantIndexes a b cs '[]
instance (Data.Variant.MapVariantIndexes a b (Data.Variant.Types.ReplaceN i b cs) is, a GHC.Types.~ Data.Variant.Types.Index i cs, GHC.TypeNats.KnownNat i) => Data.Variant.MapVariantIndexes a b cs (i : is)
instance Data.Variant.SplitVariant as rs '[]
instance (n GHC.Types.~ Data.Variant.Types.MaybeIndexOf x as, m GHC.Types.~ Data.Variant.Types.MaybeIndexOf x rs, Data.Variant.SplitVariant as rs xs, GHC.TypeNats.KnownNat m, GHC.TypeNats.KnownNat n) => Data.Variant.SplitVariant as rs (x : xs)
instance Data.Variant.PopVariant a '[]
instance (Data.Variant.PopVariant a xs', n GHC.Types.~ Data.Variant.Types.MaybeIndexOf a xs, xs' GHC.Types.~ Data.Variant.Types.RemoveAt1 n xs, Data.Variant.Types.Remove a xs' GHC.Types.~ Data.Variant.Types.Remove a xs, GHC.TypeNats.KnownNat n, xs GHC.Types.~ (y : ys)) => Data.Variant.PopVariant a (y : ys)
instance Data.Variant.ToVariantMaybe a '[]
instance (n GHC.Types.~ Data.Variant.Types.MaybeIndexOf a xs, GHC.TypeNats.KnownNat n, xs GHC.Types.~ (y : ys)) => Data.Variant.ToVariantMaybe a (y : ys)
instance Data.Variant.ShowTypeList (Data.Variant.V '[])
instance (Data.Typeable.Internal.Typeable x, Data.Variant.ShowTypeList (Data.Variant.V xs)) => Data.Variant.ShowTypeList (Data.Variant.V (x : xs))
instance Data.Variant.ShowVariantValue (Data.Variant.V '[])
instance (Data.Variant.ShowVariantValue (Data.Variant.V xs), GHC.Show.Show x, Data.Typeable.Internal.Typeable x) => Data.Variant.ShowVariantValue (Data.Variant.V (x : xs))
instance GHC.Classes.Eq (Data.Variant.V '[])
instance (GHC.Classes.Eq (Data.Variant.V xs), GHC.Classes.Eq x) => GHC.Classes.Eq (Data.Variant.V (x : xs))
instance GHC.Classes.Ord (Data.Variant.V '[])
instance (GHC.Classes.Ord (Data.Variant.V xs), GHC.Classes.Ord x) => GHC.Classes.Ord (Data.Variant.V (x : xs))
instance GHC.Show.Show (Data.Variant.V '[])
instance (GHC.Show.Show x, GHC.Show.Show (Data.Variant.V xs)) => GHC.Show.Show (Data.Variant.V (x : xs))
instance GHC.Exception.Type.Exception (Data.Variant.V '[])
instance (GHC.Exception.Type.Exception x, Data.Typeable.Internal.Typeable xs, GHC.Exception.Type.Exception (Data.Variant.V xs)) => GHC.Exception.Type.Exception (Data.Variant.V (x : xs))
instance Control.DeepSeq.NFData (Data.Variant.V '[])
instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData (Data.Variant.V xs)) => Control.DeepSeq.NFData (Data.Variant.V (x : xs))
-- | Rebindable syntax for Variant
module Data.Variant.Syntax
(>>=) :: forall x xs ys. KnownNat (Length ys) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)
(>>) :: V xs -> V ys -> V (Concat ys xs)
return :: x -> V '[x]
-- | Variant biased towards one type
--
-- This allows definition of common type classes (Functor, etc.) that
-- can't be provided for Variant
module Data.Variant.VEither
-- | Variant biased towards one type
data VEither es a
-- | Left value
--
--
-- >>> VLeft (V "failed" :: V '[String,Int]) :: VEither '[String,Int] Bool
-- VLeft "failed"
--
pattern VLeft :: forall x xs. V xs -> VEither xs x
-- | Right value
--
--
-- >>> VRight True :: VEither '[String,Int] Bool
-- VRight True
--
pattern VRight :: forall x xs. x -> VEither xs x
-- | Convert a Variant into a VEither
--
--
-- >>> let x = V "Test" :: V '[Int,String,Double]
--
-- >>> veitherFromVariant x
-- VLeft "Test"
--
veitherFromVariant :: V (a ': es) -> VEither es a
-- | Convert a VEither into a Variant
--
--
-- >>> let x = VRight True :: VEither '[Int,Float] Bool
--
-- >>> veitherToVariant x
-- True
--
veitherToVariant :: VEither es a -> V (a ': es)
-- | Extract from a VEither without left types
--
--
-- >>> let x = VRight True :: VEither '[] Bool
--
-- >>> veitherToValue x
-- True
--
veitherToValue :: forall a. VEither '[] a -> a
-- | Bimap for VEither
--
--
-- >>> let x = VRight True :: VEither '[Int,Float] Bool
--
-- >>> veitherBimap id not x
-- VRight False
--
veitherBimap :: (V es -> V fs) -> (a -> b) -> VEither es a -> VEither fs b
type VEitherLift es es' = (LiftVariant es es')
-- | Lift a VEither into another
veitherLift :: forall es' es a. VEitherLift es es' => VEither es a -> VEither es' a
-- | Append errors to VEither
veitherAppend :: forall ns es a. VEither es a -> VEither (Concat es ns) a
-- | Prepend errors to VEither
veitherPrepend :: forall ns es a. KnownNat (Length ns) => VEither es a -> VEither (Concat ns es) a
-- | VEither continuations
veitherCont :: (V es -> u) -> (a -> u) -> VEither es a -> u
-- | Convert a VEither into an Either
--
--
-- >>> let x = VRight True :: VEither '[Int,Float] Bool
--
-- >>> veitherToEither x
-- Right True
--
veitherToEither :: VEither es a -> Either (V es) a
-- | Product of two VEither
veitherProduct :: KnownNat (Length (b : e2)) => VEither e1 a -> VEither e2 b -> VEither (Tail (Product (a : e1) (b : e2))) (a, b)
instance GHC.Classes.Eq (Data.Variant.V (a : es)) => GHC.Classes.Eq (Data.Variant.VEither.VEither es a)
instance GHC.Classes.Ord (Data.Variant.V (a : es)) => GHC.Classes.Ord (Data.Variant.VEither.VEither es a)
instance (GHC.Show.Show a, GHC.Show.Show (Data.Variant.V es)) => GHC.Show.Show (Data.Variant.VEither.VEither es a)
instance GHC.Base.Functor (Data.Variant.VEither.VEither es)
instance GHC.Base.Applicative (Data.Variant.VEither.VEither es)
instance GHC.Base.Monad (Data.Variant.VEither.VEither es)
instance Data.Foldable.Foldable (Data.Variant.VEither.VEither es)
instance Data.Traversable.Traversable (Data.Variant.VEither.VEither es)
module Data.Variant.Excepts
newtype Excepts es m a
Excepts :: m (VEither es a) -> Excepts es m a
-- | Run an Excepts
runE :: forall es a m. Excepts es m a -> m (VEither es a)
-- | Run an Excepts, discard the result value
runE_ :: forall es a m. Functor m => Excepts es m a -> m ()
-- | Lift a Excepts into another
liftE :: forall es' es a m. (Monad m, VEitherLift es es') => Excepts es m a -> Excepts es' m a
-- | Append errors to an Excepts
appendE :: forall ns es a m. Monad m => Excepts es m a -> Excepts (Concat es ns) m a
-- | Prepend errors to an Excepts
prependE :: forall ns es a m. (Monad m, KnownNat (Length ns)) => Excepts es m a -> Excepts (Concat ns es) m a
-- | Signal an exception value e.
failureE :: forall e a m. Monad m => e -> Excepts '[e] m a
-- | Signal a success
successE :: forall a m. Monad m => a -> Excepts '[] m a
-- | Signal an exception value e.
throwE :: forall e es a m. (Monad m, e :< es) => e -> Excepts es m a
-- | Throw some exception
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
-- | Handle an exception. Lift both normal and exceptional flows into the
-- result flow
catchE :: forall e es' es'' es a m. (Monad m, e :< es, LiftVariant (Remove e es) es', LiftVariant es'' es') => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
-- | Evaluate a Excepts. Use the provided function to handle error cases.
catchEvalE :: Monad m => (V es -> m a) -> Excepts es m a -> m a
-- | Convert a flow without error into a value
evalE :: Monad m => Excepts '[] m a -> m a
-- | Do something in case of error
onE_ :: Monad m => m () -> Excepts es m a -> Excepts es m a
-- | Do something in case of error
onE :: Monad m => (V es -> m ()) -> Excepts es m a -> Excepts es m a
-- | Finally for Excepts
finallyE :: Monad m => m () -> Excepts es m a -> Excepts es m a
injectExcepts :: forall es a m. Monad m => Excepts es m a -> Excepts es m (VEither es a)
withExcepts :: Monad m => (VEither es a -> m b) -> Excepts es m a -> Excepts es m b
withExcepts_ :: Monad m => (VEither es a -> m ()) -> Excepts es m a -> Excepts es m a
mapExcepts :: (m (VEither es a) -> n (VEither es' b)) -> Excepts es m a -> Excepts es' n b
-- | Convert a Variant into a Excepts
variantToExcepts :: Monad m => V (a ': es) -> Excepts es m a
-- | Convert a VEither into a Excepts
veitherToExcepts :: Monad m => VEither es a -> Excepts es m a
-- | Handle an exception. Lift both normal and exceptional flows into the
-- result flow
catchLiftBoth :: forall e es' es'' es a m. (Monad m, e :< es, LiftVariant (Remove e es) es', LiftVariant es'' es') => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
-- | Handle an exception. Lift the remaining errors into the resulting flow
catchLiftLeft :: forall e es es' a m. (Monad m, e :< es, LiftVariant (Remove e es) es') => (e -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
-- | Handle an exception. Lift the handler into the resulting flow
catchLiftRight :: forall e es es' a m. (Monad m, e :< es, LiftVariant es' (Remove e es)) => (e -> Excepts es' m a) -> Excepts es m a -> Excepts (Remove e es) m a
-- | Do something in case of error
catchAllE :: Monad m => (V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
-- | Catch and die in case of error
catchDieE :: (e :< es, Monad m) => (e -> m ()) -> Excepts es m a -> Excepts (Remove e es) m a
-- | Handle an exception. Assume it is in the first position
catchRemove :: forall e es a m. Monad m => (e -> Excepts es m a) -> Excepts (e ': es) m a -> Excepts es m a
-- | Product of the sequential execution of two Excepts
--
-- The second one is run even if the first one failed!
sequenceE :: (KnownNat (Length (b : e2)), Monad m) => Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
-- | Product of the execution of two Excepts
--
-- You can use a generic monad combinator such as concurrently (in
-- "async" package) to get concurrent execution.
--
--
-- > concurrentE = runBothE concurrently
--
runBothE :: (KnownNat (Length (b : e2)), Monad m) => (forall x y. m x -> m y -> m (x, y)) -> Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
instance GHC.Show.Show (m (Data.Variant.VEither.VEither es a)) => GHC.Show.Show (Data.Variant.Excepts.Excepts es m a)
instance GHC.Base.Functor m => GHC.Base.Functor (Data.Variant.Excepts.Excepts es m)
instance Data.Foldable.Foldable m => Data.Foldable.Foldable (Data.Variant.Excepts.Excepts es m)
instance Data.Traversable.Traversable m => Data.Traversable.Traversable (Data.Variant.Excepts.Excepts es m)
instance (GHC.Base.Functor m, GHC.Base.Monad m) => GHC.Base.Applicative (Data.Variant.Excepts.Excepts es m)
instance GHC.Base.Monad m => GHC.Base.Monad (Data.Variant.Excepts.Excepts es m)
instance Control.Monad.Fail.MonadFail m => Control.Monad.Fail.MonadFail (Data.Variant.Excepts.Excepts es m)
instance Control.Monad.Trans.Class.MonadTrans (Data.Variant.Excepts.Excepts e)
instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Data.Variant.Excepts.Excepts es m)
instance Control.Monad.Catch.MonadThrow m => Control.Monad.Catch.MonadThrow (Data.Variant.Excepts.Excepts e m)
instance Control.Monad.Catch.MonadCatch m => Control.Monad.Catch.MonadCatch (Data.Variant.Excepts.Excepts e m)
instance Control.Monad.Catch.MonadMask m => Control.Monad.Catch.MonadMask (Data.Variant.Excepts.Excepts e m)
instance Control.Monad.Reader.Class.MonadReader r m => Control.Monad.Reader.Class.MonadReader r (Data.Variant.Excepts.Excepts e m)
instance (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Unlift.MonadUnliftIO m, GHC.Exception.Type.Exception (Data.Variant.V es)) => Control.Monad.IO.Unlift.MonadUnliftIO (Data.Variant.Excepts.Excepts es m)
-- | VariantF functor
module Data.Variant.VariantF
-- | Recursive Functor-like Variant
newtype VariantF (xs :: [t -> Type]) (e :: t)
VariantF :: V (ApplyAll e xs) -> VariantF (xs :: [t -> Type]) (e :: t)
-- | Apply its first argument to every element of the 2nd arg list
--
--
-- ApplyAll e '[f,g,h] ==> '[f e, g e, h e]
--
type family ApplyAll (e :: t) (xs :: [t -> k]) :: [k]
-- | Pattern-match in a VariantF
--
--
-- >>> FV (NilF :: NilF String) :: VariantF '[ConsF Char,NilF] String
-- NilF
--
pattern FV :: forall c cs e. c :< ApplyAll e cs => c -> VariantF cs e
appendVariantF :: forall (ys :: [Type -> Type]) (xs :: [Type -> Type]) e. ApplyAll e (Concat xs ys) ~ Concat (ApplyAll e xs) (ApplyAll e ys) => VariantF xs e -> VariantF (Concat xs ys) e
prependVariantF :: forall (xs :: [Type -> Type]) (ys :: [Type -> Type]) e. (ApplyAll e (Concat xs ys) ~ Concat (ApplyAll e xs) (ApplyAll e ys), KnownNat (Length (ApplyAll e xs))) => VariantF ys e -> VariantF (Concat xs ys) e
-- | Set the first value
toVariantFHead :: forall x xs e. x e -> VariantF (x ': xs) e
-- | Set the tail
toVariantFTail :: forall x xs e. VariantF xs e -> VariantF (x ': xs) e
-- | Pop VariantF head
popVariantFHead :: forall x xs e. VariantF (x ': xs) e -> Either (VariantF xs e) (x e)
-- | Retrieve a single value
variantFToValue :: VariantF '[f] e -> f e
type MapVariantF a b cs ds e = (MapVariant (a e) (b e) (ApplyAll e cs), ds ~ ReplaceNS (IndexesOf a cs) b cs, ApplyAll e ds ~ ReplaceNS (IndexesOf (a e) (ApplyAll e cs)) (b e) (ApplyAll e cs))
-- | Map the matching types of a variant
mapVariantF :: forall a b cs ds e. MapVariantF a b cs ds e => (a e -> b e) -> VariantF cs e -> VariantF ds e
type PopVariantF x xs e = (x e :< ApplyAll e xs, Remove (x e) (ApplyAll e xs) ~ ApplyAll e (Remove x xs))
-- | Pop VariantF
popVariantF :: forall x xs e. PopVariantF x xs e => VariantF xs e -> Either (VariantF (Remove x xs) e) (x e)
-- | xs is liftable in ys
type LiftVariantF xs ys e = (LiftVariant (ApplyAll e xs) (ApplyAll e ys))
-- | Lift a VariantF into another
liftVariantF :: forall as bs e. LiftVariantF as bs e => VariantF as e -> VariantF bs e
type SplitVariantF as xs e = (Complement (ApplyAll e xs) (ApplyAll e as) ~ ApplyAll e (Complement xs as), 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 (Complement xs as) e) (VariantF as e)
-- | Convert a VariantF into a multi-continuation
variantFToCont :: ContVariant (ApplyAll e xs) => VariantF xs e -> ContFlow (ApplyAll e xs) r
-- | Convert a VariantF into a multi-continuation
variantFToContM :: (ContVariant (ApplyAll e xs), Monad m) => m (VariantF xs e) -> ContFlow (ApplyAll e xs) (m r)
-- | Convert a multi-continuation into a VariantF
contToVariantF :: forall xs e. ContVariant (ApplyAll e xs) => ContFlow (ApplyAll e xs) (V (ApplyAll e xs)) -> VariantF xs e
-- | Convert a multi-continuation into a VariantF
contToVariantFM :: forall xs e m. (ContVariant (ApplyAll e xs), Monad m) => ContFlow (ApplyAll e xs) (m (V (ApplyAll e xs))) -> m (VariantF xs e)
type family BottomUpF c fs :: Constraint
class BottomUp c fs
toBottomUp :: BottomUp c fs => (forall f. c f => f a -> b) -> VariantF fs a -> b
class BottomUpOrig c fs
toBottomUpOrig :: BottomUpOrig c fs => (forall f. c f => f (t, a) -> b) -> VariantF fs (t, a) -> b
type family BottomUpOrigF c fs :: Constraint
class TopDownStop c fs
toTopDownStop :: TopDownStop c fs => (forall f. c f => TopDownStopT a f) -> TopDownStopT a (VariantF fs)
type family TopDownStopF c fs :: Constraint
-- | Useful to specify a "Type -> Constraint" function returning an
-- empty constraint
class NoConstraint a
instance forall t (e :: t) (xs :: [t -> *]). Control.DeepSeq.NFData (Data.Variant.V (Data.Variant.VariantF.ApplyAll e xs)) => Control.DeepSeq.NFData (Data.Variant.VariantF.VariantF xs e)
instance Data.Variant.VariantF.TopDownStop c '[]
instance (Data.Variant.VariantF.TopDownStop c fs, GHC.Base.Functor f, c f) => Data.Variant.VariantF.TopDownStop c (f : fs)
instance Data.Variant.VariantF.BottomUpOrig c '[]
instance (Data.Variant.VariantF.BottomUpOrig c fs, c f) => Data.Variant.VariantF.BottomUpOrig c (f : fs)
instance forall t (c :: (t -> *) -> GHC.Types.Constraint). Data.Variant.VariantF.BottomUp c '[]
instance forall t (c :: (t -> *) -> GHC.Types.Constraint) (fs :: [t -> *]) (f :: t -> *). (Data.Variant.VariantF.BottomUp c fs, c f) => Data.Variant.VariantF.BottomUp c (f : fs)
instance (Data.Functor.Classes.Eq1 (Data.Variant.VariantF.VariantF xs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Eq1 xs, GHC.Classes.Eq e) => GHC.Classes.Eq (Data.Variant.VariantF.VariantF xs e)
instance (Data.Functor.Classes.Ord1 (Data.Variant.VariantF.VariantF xs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Ord1 xs, Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Eq1 xs, GHC.Classes.Ord e) => GHC.Classes.Ord (Data.Variant.VariantF.VariantF xs e)
instance Data.Functor.Classes.Eq1 (Data.Variant.VariantF.VariantF '[])
instance (Data.Functor.Classes.Eq1 f, Data.Functor.Classes.Eq1 (Data.Variant.VariantF.VariantF fs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Eq1 fs) => Data.Functor.Classes.Eq1 (Data.Variant.VariantF.VariantF (f : fs))
instance Data.Functor.Classes.Ord1 (Data.Variant.VariantF.VariantF '[])
instance (Data.Functor.Classes.Ord1 f, Data.Functor.Classes.Ord1 (Data.Variant.VariantF.VariantF fs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Eq1 fs, Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Ord1 fs) => Data.Functor.Classes.Ord1 (Data.Variant.VariantF.VariantF (f : fs))
instance Data.Functor.Classes.Show1 (Data.Variant.VariantF.VariantF '[])
instance (Data.Functor.Classes.Show1 f, Data.Functor.Classes.Show1 (Data.Variant.VariantF.VariantF fs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Show1 fs) => Data.Functor.Classes.Show1 (Data.Variant.VariantF.VariantF (f : fs))
instance (Data.Functor.Classes.Show1 (Data.Variant.VariantF.VariantF xs), Data.Variant.Types.ConstraintAll1 Data.Functor.Classes.Show1 xs, GHC.Show.Show e) => GHC.Show.Show (Data.Variant.VariantF.VariantF xs e)
instance GHC.Base.Functor (Data.Variant.VariantF.VariantF '[])
instance (GHC.Base.Functor (Data.Variant.VariantF.VariantF fs), GHC.Base.Functor f) => GHC.Base.Functor (Data.Variant.VariantF.VariantF (f : fs))
instance forall t (e :: t) (xs :: [t -> *]). Data.Variant.ContVariant (Data.Variant.VariantF.ApplyAll e xs) => Data.Variant.ContFlow.MultiCont (Data.Variant.VariantF.VariantF xs e)
module Data.Variant.EGADT
-- | An EADT with an additional type parameter
newtype EGADT fs t
EGADT :: HVariantF fs (EGADT fs) t -> EGADT fs t
newtype HVariantF (fs :: [(k -> Type) -> (k -> Type)]) (ast :: k -> Type) (t :: k)
HVariantF :: VariantF (ApplyAll ast fs) t -> HVariantF (fs :: [(k -> Type) -> k -> Type]) (ast :: k -> Type) (t :: k)
toHVariantAt :: forall i fs ast a. KnownNat i => Index i fs ast a -> VariantF (ApplyAll ast fs) a
fromHVariantAt :: forall i fs ast a. KnownNat i => VariantF (ApplyAll ast fs) a -> Maybe (Index i fs ast a)
type family f : f (EGADT fs) a -> EGADT fs a
instance forall k (xs :: [(k -> *) -> k -> *]). Data.Variant.Functor.HFunctor (Data.Variant.EGADT.HVariantF xs) => Data.Variant.Functor.HRecursive (Data.Variant.EGADT.EGADT xs)
instance forall k (xs :: [(k -> *) -> k -> *]). Data.Variant.Functor.HFunctor (Data.Variant.EGADT.HVariantF xs) => Data.Variant.Functor.HCorecursive (Data.Variant.EGADT.EGADT xs)
-- | Extensible ADT
module Data.Variant.EADT
-- | An extensible ADT
newtype EADT fs
EADT :: VariantF fs (EADT fs) -> EADT fs
-- | Constructor f is in xs
type family f :<: xs
-- | Forall x in xs, `x :<: ys`
type family (:<<:) xs ys :: Constraint
-- | Pattern-match in an extensible ADT
pattern VF :: forall e f cs. (e ~ EADT cs, f :<: cs) => f (EADT cs) -> EADT cs
-- | Append new "constructors" to the EADT
appendEADT :: forall ys xs zs. (zs ~ Concat xs ys, ApplyAll (EADT zs) zs ~ Concat (ApplyAll (EADT zs) xs) (ApplyAll (EADT zs) ys), Functor (VariantF xs)) => EADT xs -> EADT zs
-- | Lift an EADT into another
liftEADT :: forall e as bs. (e ~ EADT bs, LiftVariantF as bs e, Functor (VariantF as)) => EADT as -> EADT bs
-- | Pop an EADT value
popEADT :: forall f xs e. (f :<: xs, e ~ EADT xs, f e :< ApplyAll e xs) => EADT xs -> Either (VariantF (Remove f xs) (EADT xs)) (f (EADT xs))
-- | Convert a multi-continuation into an EADT
contToEADT :: ContVariant (ApplyAll (EADT xs) xs) => ContFlow (ApplyAll (EADT xs) xs) (V (ApplyAll (EADT xs) xs)) -> EADT xs
-- | Convert a multi-continuation into an EADT
contToEADTM :: (ContVariant (ApplyAll (EADT xs) xs), Monad f) => ContFlow (ApplyAll (EADT xs) xs) (f (V (ApplyAll (EADT xs) xs))) -> f (EADT xs)
class EADTShow f
eadtShow' :: EADTShow f => f String -> String
-- | Show an EADT
eadtShow :: forall xs. BottomUpF EADTShow xs => EADT xs -> String
instance GHC.Base.Functor (Data.Variant.VariantF.VariantF fs) => Data.Functor.Foldable.Recursive (Data.Variant.EADT.EADT fs)
instance GHC.Base.Functor (Data.Variant.VariantF.VariantF fs) => Data.Functor.Foldable.Corecursive (Data.Variant.EADT.EADT fs)
instance Data.Functor.Classes.Eq1 (Data.Variant.VariantF.VariantF fs) => GHC.Classes.Eq (Data.Variant.EADT.EADT fs)
instance Data.Functor.Classes.Ord1 (Data.Variant.VariantF.VariantF fs) => GHC.Classes.Ord (Data.Variant.EADT.EADT fs)
instance Data.Functor.Classes.Show1 (Data.Variant.VariantF.VariantF fs) => GHC.Show.Show (Data.Variant.EADT.EADT fs)
instance (GHC.Base.Functor (Data.Variant.VariantF.VariantF xs), Data.Variant.ContVariant (Data.Variant.VariantF.ApplyAll (Data.Variant.EADT.EADT xs) xs)) => Data.Variant.ContFlow.MultiCont (Data.Variant.EADT.EADT xs)
-- | Template-Haskell helpers for EADTs
module Data.Variant.EADT.TH
-- | Create a pattern synonym for an EADT constructor
--
-- E.g.
--
--
-- data ConsF a e = ConsF a e deriving (Functor)
-- $(eadtPattern 'ConsF "Cons")
--
-- ====>
--
-- pattern Cons :: ConsF a :<: xs => a -> EADT xs -> EADT xs
-- pattern Cons a l = VF (ConsF a l)
--
eadtPattern :: Name -> String -> Q [Dec]
-- | Create an infix pattern synonym for an EADT constructor
--
-- E.g.
--
--
-- data ConsF a e = ConsF a e deriving (Functor)
-- $(eadtInfixPattern 'ConsF ":->")
--
-- ====>
--
-- pattern (:->) :: ConsF a :<: xs => a -> EADT xs -> EADT xs
-- pattern a :-> l = VF (ConsF a l)
--
eadtInfixPattern :: Name -> String -> Q [Dec]
-- | Create a pattern synonym for an EADT constructor that is part of a
-- specified EADT.
--
-- This can be useful to help the type inference because instead of using
-- a generic "EADT xs" type, the pattern uses the provided type.
--
-- E.g.
--
--
-- data ConsF a e = ConsF a e deriving (Functor)
-- data NilF e = NilF deriving (Functor)
--
-- type List a = EADT '[ConsF a, NilF]
--
-- $(eadtPatternT 'ConsF "ConsList" [t|forall a. List a|])
--
-- ====>
--
-- pattern ConsList ::
-- ( List a ~ EADT xs
-- , ConsF a :<: xs
-- ) => a -> List a -> List a
-- pattern ConsList a l = VF (ConsF a l)
--
--
-- Note that you have to quantify free variables explicitly with
-- forall
eadtPatternT :: Name -> String -> Q Type -> Q [Dec]
-- | Like eadtPatternT but generating an infix pattern synonym
eadtInfixPatternT :: Name -> String -> Q Type -> Q [Dec]