-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Haskus data utility modules -- -- Haskus data utility modules @package haskus-utils-data @version 1.5 module Haskus.Utils.Either -- | 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 Haskus.Utils.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) -- | Infinite list module Haskus.Utils.InfList -- | An infinite list data InfList a (:>) :: a -> InfList a -> InfList a -- | Convert to a standard list toList :: InfList a -> [a] -- | Repeat for infinite list repeat :: a -> InfList a -- | Take for infinite list take :: Word -> InfList a -> [a] -- | Replicate for infinite list replicate :: Word -> a -> InfList a -> InfList a instance Data.Foldable.Foldable Haskus.Utils.InfList.InfList instance GHC.Base.Functor Haskus.Utils.InfList.InfList -- | List utils module Haskus.Utils.List -- | Safely index into a list -- --
-- >>> [0,1,2,3] `at` 10 -- Nothing ---- --
-- >>> [0,1,2,3] `at` 2 -- Just 2 --at :: [a] -> Word -> Maybe a -- | Unsafe a -- --
-- >>> [0,1,2,3] `unsafeAt` 2 -- 2 --unsafeAt :: [a] -> Word -> a -- | Check that a list has the given length (support infinite lists) checkLength :: Word -> [a] -> Bool -- | Append two lists, i.e., -- --
-- [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] -- [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] ---- -- If the first list is not finite, the result is the first list. -- -- WARNING: This function takes linear time in the number of elements of -- the first list. (++) :: [a] -> [a] -> [a] infixr 5 ++ -- | Replicate replicate :: Word -> a -> [a] -- | Drop drop :: Word -> [a] -> [a] -- | Length length :: Foldable t => t a -> Word -- | Take take :: Word -> [a] -> [a] -- | Split a list into chunks of a given size. The last chunk may contain -- fewer than n elements. -- --
-- >>> chunksOf 3 "my test" -- ["my ","tes","t"] ---- --
-- >>> chunksOf 3 "mytest" -- ["myt","est"] ---- --
-- >>> chunksOf 8 "" -- [] ---- --
-- > chunksOf 0 "test" ---- -- undefined chunksOf :: Word -> [a] -> [[a]] -- | Pick each element and return the element and the rest of the list -- --
-- >>> pick1 [1,2,3,4] -- [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])] --pick1 :: [a] -> [(a, [a])] -- | Get members of a bounded enum in a list -- --
-- >>> :seti -XTypeApplications -- -- >>> data Letters = A | B | C | D deriving (Bounded,Enum,Show) -- -- >>> enumList @Letters -- [A,B,C,D] --enumList :: forall a. (Bounded a, Enum a) => [a] -- | Zip left with something extracted from each value -- --
-- >>> zipLeftWith odd [0..5] -- [(False,0),(True,1),(False,2),(True,3),(False,4),(True,5)] --zipLeftWith :: (a -> b) -> [a] -> [(b, a)] -- | Zip right with something extracted from each value -- --
-- >>> zipRightWith odd [0..5] -- [(0,False),(1,True),(2,False),(3,True),(4,False),(5,True)] --zipRightWith :: (a -> b) -> [a] -> [(a, b)] -- | The partition function takes a predicate and a list, and -- returns the pair of lists of elements which do and do not satisfy the -- predicate, respectively; i.e., -- --
-- partition p xs == (filter p xs, filter (not . p) xs) ---- --
-- >>> partition (`elem` "aeiou") "Hello World!"
-- ("eoo","Hll Wrld!")
--
partition :: (a -> Bool) -> [a] -> ([a], [a])
-- | <math>. The nub function removes duplicate elements from
-- a list. In particular, it keeps only the first occurrence of each
-- element. (The name nub means `essence'.) It is a special case
-- of nubBy, which allows the programmer to supply their own
-- equality test.
--
-- -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] ---- -- If the order of outputs does not matter and there exists instance -- Ord a, it's faster to use map -- Data.List.NonEmpty.head . -- Data.List.NonEmpty.group . sort, which takes -- only <math> time. nub :: Eq a => [a] -> [a] -- | The sort function implements a stable sorting algorithm. It is -- a special case of sortBy, which allows the programmer to supply -- their own comparison function. -- -- Elements are arranged from lowest to highest, keeping duplicates in -- the order they appeared in the input. -- --
-- >>> sort [1,6,4,3,2,5] -- [1,2,3,4,5,6] ---- -- The argument must be finite. sort :: Ord a => [a] -> [a] -- | <math>. The intersperse function takes an element and a -- list and `intersperses' that element between the elements of the list. -- For example, -- --
-- >>> intersperse ',' "abcde" -- "a,b,c,d,e" --intersperse :: a -> [a] -> [a] -- | Left-associative fold of a structure but with strict application of -- the operator. -- -- This ensures that each step of the fold is forced to Weak Head Normal -- Form before being applied, avoiding the collection of thunks that -- would otherwise occur. This is often what you want to strictly reduce -- a finite structure to a single strict result (e.g. sum). -- -- For a general Foldable structure this should be semantically -- identical to, -- --
-- foldl' f z = foldl' f z . toList --foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b -- | <math>. Extract the first element of a list, which must be -- non-empty. -- --
-- >>> head [1, 2, 3] -- 1 -- -- >>> head [1..] -- 1 -- -- >>> head [] -- *** Exception: Prelude.head: empty list ---- -- WARNING: This function is partial. You can use case-matching, -- uncons or listToMaybe instead. head :: HasCallStack => [a] -> a -- | <math>. Extract the elements after the head of a list, which -- must be non-empty. -- --
-- >>> tail [1, 2, 3] -- [2,3] -- -- >>> tail [1] -- [] -- -- >>> tail [] -- *** Exception: Prelude.tail: empty list ---- -- WARNING: This function is partial. You can use case-matching or -- uncons instead. tail :: HasCallStack => [a] -> [a] -- | <math>. zipWith generalises zip by zipping with -- the function given as the first argument, instead of a tupling -- function. -- --
-- zipWith (,) xs ys == zip xs ys -- zipWith f [x1,x2,x3..] [y1,y2,y3..] == [f x1 y1, f x2 y2, f x3 y3..] ---- -- For example, zipWith (+) is applied to two lists to -- produce the list of corresponding sums: -- --
-- >>> zipWith (+) [1, 2, 3] [4, 5, 6] -- [5,7,9] ---- -- zipWith is right-lazy: -- --
-- >>> let f = undefined -- -- >>> zipWith f [] undefined -- [] ---- -- zipWith is capable of list fusion, but it is restricted to its -- first list argument and its resulting list. zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] -- | repeat x is an infinite list, with x the -- value of every element. -- --
-- >>> repeat 17 -- [17,17,17,17,17,17,17,17,17... --repeat :: a -> [a] -- | A version of nub where the equality is done on some extracted -- value. nubOn f is equivalent to nubBy ((==) on -- f), but has the performance advantage of only evaluating -- f once for each element in the input list. nubOn :: Eq b => (a -> b) -> [a] -> [a] -- | The nubBy function behaves just like nub, except it uses -- a user-supplied equality predicate instead of the overloaded == -- function. -- --
-- >>> nubBy (\x y -> mod x 3 == mod y 3) [1,2,4,5,6] -- [1,2,6] --nubBy :: (a -> a -> Bool) -> [a] -> [a] -- | Sort a list by comparing the results of a key function applied to each -- element. sortOn f is equivalent to sortBy -- (comparing f), but has the performance advantage of only -- evaluating f once for each element in the input list. This is -- called the decorate-sort-undecorate paradigm, or Schwartzian -- transform. -- -- Elements are arranged from lowest to highest, keeping duplicates in -- the order they appeared in the input. -- --
-- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")] -- [(1,"Hello"),(2,"world"),(4,"!")] ---- -- The argument must be finite. sortOn :: Ord b => (a -> b) -> [a] -> [a] -- | The sortBy function is the non-overloaded version of -- sort. The argument must be finite. -- --
-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")] -- [(1,"Hello"),(2,"world"),(4,"!")] ---- -- The supplied comparison relation is supposed to be reflexive and -- antisymmetric, otherwise, e. g., for _ _ -> GT, the -- ordered list simply does not exist. The relation is also expected to -- be transitive: if it is not then sortBy might fail to find an -- ordered permutation, even if it exists. sortBy :: (a -> a -> Ordering) -> [a] -> [a] -- | A version of group where the equality is done on some -- extracted value. groupOn :: Eq b => (a -> b) -> [a] -> [[a]] -- | The groupBy function is the non-overloaded version of -- group. -- -- When a supplied relation is not transitive, it is important to -- remember that equality is checked against the first element in the -- group, not against the nearest neighbour: -- --
-- >>> groupBy (\a b -> b - a < 5) [0..19] -- [[0,1,2,3,4],[5,6,7,8,9],[10,11,12,13,14],[15,16,17,18,19]] ---- -- It's often preferable to use -- Data.List.NonEmpty.groupBy, which provides type-level -- guarantees of non-emptiness of inner lists. groupBy :: (a -> a -> Bool) -> [a] -> [[a]] -- | The transpose function transposes the rows and columns of its -- argument. For example, -- --
-- >>> transpose [[1,2,3],[4,5,6]] -- [[1,4],[2,5],[3,6]] ---- -- If some of the rows are shorter than the following rows, their -- elements are skipped: -- --
-- >>> transpose [[10,11],[20],[],[30,31,32]] -- [[10,20,30],[11,31],[32]] ---- -- For this reason the outer list must be finite; otherwise -- transpose hangs: -- --
-- >>> transpose (repeat []) -- * Hangs forever * --transpose :: [[a]] -> [[a]] -- | The \\ function is list difference (non-associative). In the -- result of xs \\ ys, the first occurrence of -- each element of ys in turn (if any) has been removed from -- xs. Thus (xs ++ ys) \\ xs == ys. -- --
-- >>> "Hello World!" \\ "ell W" -- "Hoorld!" ---- -- It is a special case of deleteFirstsBy, which allows the -- programmer to supply their own equality test. -- -- The second list must be finite, but the first may be infinite. -- --
-- >>> take 5 ([0..] \\ [2..4]) -- [0,1,5,6,7] -- -- >>> take 5 ([0..] \\ [2..]) -- * Hangs forever * --(\\) :: Eq a => [a] -> [a] -> [a] infix 5 \\ -- | The intersect function takes the list intersection of two -- lists. It is a special case of intersectBy, which allows the -- programmer to supply their own equality test. For example, -- --
-- >>> [1,2,3,4] `intersect` [2,4,6,8] -- [2,4] ---- -- If equal elements are present in both lists, an element from the first -- list will be used, and all duplicates from the second list quashed: -- --
-- >>> import Data.Semigroup -- -- >>> intersect [Arg () "dog"] [Arg () "cow", Arg () "cat"] -- [Arg () "dog"] ---- -- However if the first list contains duplicates, so will the result. -- --
-- >>> "coot" `intersect` "heron" -- "oo" -- -- >>> "heron" `intersect` "coot" -- "o" ---- -- If the second list is infinite, intersect either hangs or -- returns its first argument in full. Otherwise if the first list is -- infinite, intersect might be productive: -- --
-- >>> intersect [100..] [0..] -- [100,101,102,103... -- -- >>> intersect [0] [1..] -- * Hangs forever * -- -- >>> intersect [1..] [0] -- * Hangs forever * -- -- >>> intersect (cycle [1..3]) [2] -- [2,2,2,2... --intersect :: Eq a => [a] -> [a] -> [a] -- | The find function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- Nothing if there is no such element. -- --
-- >>> find (> 42) [0, 5..] -- Just 45 ---- --
-- >>> find (> 12) [1..7] -- Nothing --find :: Foldable t => (a -> Bool) -> t a -> Maybe a -- | zip3 takes three lists and returns a list of triples, analogous -- to zip. It is capable of list fusion, but it is restricted to -- its first list argument and its resulting list. zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] -- | The zip4 function takes four lists and returns a list of -- quadruples, analogous to zip. It is capable of list fusion, but -- it is restricted to its first list argument and its resulting list. zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] -- | The zip5 function takes five lists and returns a list of -- five-tuples, analogous to zip. It is capable of list fusion, -- but it is restricted to its first list argument and its resulting -- list. zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)] -- | The zip6 function takes six lists and returns a list of -- six-tuples, analogous to zip. It is capable of list fusion, but -- it is restricted to its first list argument and its resulting list. zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)] -- | The zip7 function takes seven lists and returns a list of -- seven-tuples, analogous to zip. It is capable of list fusion, -- but it is restricted to its first list argument and its resulting -- list. zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)] -- | <math>. The stripPrefix function drops the given prefix -- from a list. It returns Nothing if the list did not start with -- the prefix given, or Just the list after the prefix, if it -- does. -- --
-- >>> stripPrefix "foo" "foobar" -- Just "bar" ---- --
-- >>> stripPrefix "foo" "foo" -- Just "" ---- --
-- >>> stripPrefix "foo" "barfoo" -- Nothing ---- --
-- >>> stripPrefix "foo" "barfoobaz" -- Nothing --stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] -- | <math>. The isPrefixOf function takes two lists and -- returns True iff the first list is a prefix of the second. -- --
-- >>> "Hello" `isPrefixOf` "Hello World!" -- True -- -- >>> "Hello" `isPrefixOf` "Wello Horld!" -- False ---- -- For the result to be True, the first list must be finite; -- False, however, results from any mismatch: -- --
-- >>> [0..] `isPrefixOf` [1..] -- False -- -- >>> [0..] `isPrefixOf` [0..99] -- False -- -- >>> [0..99] `isPrefixOf` [0..] -- True -- -- >>> [0..] `isPrefixOf` [0..] -- * Hangs forever * --isPrefixOf :: Eq a => [a] -> [a] -> Bool -- | <math>. The deleteBy function behaves like delete, -- but takes a user-supplied equality predicate. -- --
-- >>> deleteBy (<=) 4 [1..10] -- [1,2,3,5,6,7,8,9,10] --deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] -- | The isSuffixOf function takes two lists and returns True -- iff the first list is a suffix of the second. -- --
-- >>> "ld!" `isSuffixOf` "Hello World!" -- True -- -- >>> "World" `isSuffixOf` "Hello World!" -- False ---- -- The second list must be finite; however the first list may be -- infinite: -- --
-- >>> [0..] `isSuffixOf` [0..99] -- False -- -- >>> [0..99] `isSuffixOf` [0..] -- * Hangs forever * --isSuffixOf :: Eq a => [a] -> [a] -> Bool -- | Does the element occur in the structure? -- -- Note: elem is often used in infix form. -- --
-- >>> 3 `elem` [] -- False ---- --
-- >>> 3 `elem` [1,2] -- False ---- --
-- >>> 3 `elem` [1,2,3,4,5] -- True ---- -- For infinite structures, the default implementation of elem -- terminates if the sought-after value exists at a finite distance from -- the left side of the structure: -- --
-- >>> 3 `elem` [1..] -- True ---- --
-- >>> 3 `elem` ([4..] ++ [3]) -- * Hangs forever * --elem :: (Foldable t, Eq a) => a -> t a -> Bool infix 4 `elem` -- | notElem is the negation of elem. -- --
-- >>> 3 `notElem` [] -- True ---- --
-- >>> 3 `notElem` [1,2] -- True ---- --
-- >>> 3 `notElem` [1,2,3,4,5] -- False ---- -- For infinite structures, notElem terminates if the value exists -- at a finite distance from the left side of the structure: -- --
-- >>> 3 `notElem` [1..] -- False ---- --
-- >>> 3 `notElem` ([4..] ++ [3]) -- * Hangs forever * --notElem :: (Foldable t, Eq a) => a -> t a -> Bool infix 4 `notElem` -- | splitAt n xs returns a tuple where first element is -- xs prefix of length n and second element is the -- remainder of the list: -- --
-- splitAt 6 "Hello World!" == ("Hello ","World!")
-- splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])
-- splitAt 1 [1,2,3] == ([1],[2,3])
-- splitAt 3 [1,2,3] == ([1,2,3],[])
-- splitAt 4 [1,2,3] == ([1,2,3],[])
-- splitAt 0 [1,2,3] == ([],[1,2,3])
-- splitAt (-1) [1,2,3] == ([],[1,2,3])
--
--
-- It is equivalent to (take n xs, drop n xs) when
-- n is not _|_ (splitAt _|_ xs = _|_).
splitAt :: Integral n => n -> [a] -> ([a], [a])
-- | Splits a list into components delimited by separators, where the
-- predicate returns True for a separator element. The resulting
-- components do not contain the separators. Two adjacent separators
-- result in an empty component in the output.
--
-- -- split (== 'a') "aabbaca" == ["","","bb","c",""] -- split (== 'a') "" == [""] -- split (== ':') "::xyz:abc::123::" == ["","","xyz","abc","","123","",""] -- split (== ',') "my,list,here" == ["my","list","here"] --split :: (a -> Bool) -> [a] -> [[a]] -- | Break a list into pieces separated by the first list argument, -- consuming the delimiter. An empty delimiter is invalid, and will cause -- an error to be raised. -- --
-- splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"] -- splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""] -- splitOn "x" "x" == ["",""] -- splitOn "x" "" == [""] -- \s x -> s /= "" ==> intercalate s (splitOn s x) == x -- \c x -> splitOn [c] x == split (==c) x --splitOn :: Eq a => [a] -> [a] -> [[a]] -- | Find the first instance of needle in haystack. The -- first element of the returned tuple is the prefix of haystack -- before needle is matched. The second is the remainder of -- haystack, starting with the match. If you want the remainder -- without the match, use stripInfix. -- --
-- breakOn "::" "a::b::c" == ("a", "::b::c")
-- breakOn "/" "foobar" == ("foobar", "")
-- \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
--
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
module Haskus.Utils.Map
module Haskus.Utils.Map.Strict
-- | Utils for Maybe data type
module Haskus.Utils.Maybe
-- | Flipped fromMaybe
onNothing :: Maybe a -> a -> a
-- | Flipped fromMaybeM
onNothingM :: Monad m => m (Maybe a) -> m a -> m a
-- | fromMaybe in a Monad
fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
-- | Get the head of the list if the latter is not empty
headMaybe :: [a] -> Maybe a
-- | Utils for Monads
module Haskus.Utils.Monad
class MonadIO m => MonadInIO m
-- | Lift with*-like functions into IO (alloca, etc.)
liftWith :: MonadInIO m => (forall c. (a -> IO c) -> IO c) -> (a -> m b) -> m b
-- | Lift with*-like functions into IO (alloca, etc.)
liftWith2 :: MonadInIO m => (forall c. (a -> b -> IO c) -> IO c) -> (a -> b -> m e) -> m e
-- | Keep running an operation until it becomes False. As an
-- example:
--
-- -- whileM $ do sleep 0.1; notM $ doesFileExist "foo.txt" -- readFile "foo.txt" ---- -- If you need some state persisted between each test, use loopM. whileM :: Monad m => m Bool -> m () -- | A looping operation, where the predicate returns Left as a seed -- for the next loop or Right to abort the loop. -- --
-- loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16" --loop :: (a -> Either a b) -> a -> b -- | A monadic version of loop, where the predicate returns -- Left as a seed for the next loop or Right to abort the -- loop. loopM :: Monad m => (a -> m (Either a b)) -> a -> m b -- | Like when, but where the test can be monadic. whenM :: Monad m => m Bool -> m () -> m () -- | Like unless, but where the test can be monadic. unlessM :: Monad m => m Bool -> m () -> m () -- | Like if, but where the test can be monadic. ifM :: Monad m => m Bool -> m a -> m a -> m a -- | Like not, but where the test can be monadic. notM :: Functor m => m Bool -> m Bool -- | A version of any lifted to a monad. Retains the -- short-circuiting behaviour. -- --
-- anyM Just [False,True ,undefined] == Just True -- anyM Just [False,False,undefined] == undefined -- \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs) --anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool -- | A version of all lifted to a monad. Retains the -- short-circuiting behaviour. -- --
-- allM Just [True,False,undefined] == Just False -- allM Just [True,True ,undefined] == undefined -- \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs) --allM :: Monad m => (a -> m Bool) -> [a] -> m Bool -- | A version of or lifted to a monad. Retains the short-circuiting -- behaviour. -- --
-- orM [Just False,Just True ,undefined] == Just True -- orM [Just False,Just False,undefined] == undefined -- \xs -> Just (or xs) == orM (map Just xs) --orM :: Monad m => [m Bool] -> m Bool -- | A version of and lifted to a monad. Retains the -- short-circuiting behaviour. -- --
-- andM [Just True,Just False,undefined] == Just False -- andM [Just True,Just True ,undefined] == undefined -- \xs -> Just (and xs) == andM (map Just xs) --andM :: Monad m => [m Bool] -> m Bool instance Haskus.Utils.Monad.MonadInIO GHC.Types.IO instance Haskus.Utils.Monad.MonadInIO m => Haskus.Utils.Monad.MonadInIO (Control.Monad.Trans.State.Lazy.StateT s m) -- | Tuple helpers module Haskus.Utils.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 Haskus.Utils.Tuple.ExtractTuple 0 '[a] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2, e3] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2, e3] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2, e3] instance Haskus.Utils.Tuple.ExtractTuple 3 '[e0, e1, e2, e3] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4] instance Haskus.Utils.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4] instance Haskus.Utils.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 6 '[e0, e1, e2, e3, e4, e5, e6] instance Haskus.Utils.Tuple.ExtractTuple 0 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 1 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 2 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 3 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 4 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 5 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 6 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.ExtractTuple 7 '[e0, e1, e2, e3, e4, e5, e6, e7] instance Haskus.Utils.Tuple.TupleCon '[] instance Haskus.Utils.Tuple.TupleCon '[a] instance Haskus.Utils.Tuple.TupleCon '[a, b] instance Haskus.Utils.Tuple.TupleCon '[a, b, c] instance Haskus.Utils.Tuple.TupleCon '[a, b, c, d] instance Haskus.Utils.Tuple.TupleCon '[a, b, c, d, e] instance Haskus.Utils.Tuple.TupleCon '[a, b, c, d, e, f] instance Haskus.Utils.Tuple.ReorderTuple (Solo a) (Solo a) instance Haskus.Utils.Tuple.ReorderTuple (a, b) (a, b) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (a, b, c) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (a, b, c, d) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (a, b, c, d, e) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (a, b, c, d, e, f) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g, h) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h, i) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i, j) instance Haskus.Utils.Tuple.ReorderTuple (a, b) (b, a) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (a, c, b) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (b, a, c) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (b, c, a) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (c, a, b) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (c, b, a) instance Haskus.Utils.Tuple.ReorderTuple (b, c, d) (x, y, z) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (a, x, y, z) instance Haskus.Utils.Tuple.ReorderTuple (a, c, d) (x, y, z) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (x, b, y, z) instance Haskus.Utils.Tuple.ReorderTuple (a, b, d) (x, y, z) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (x, y, c, z) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c) (x, y, z) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (x, y, z, d) instance Haskus.Utils.Tuple.ReorderTuple (b, c, d, e) (x, y, z, w) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (a, x, y, z, w) instance Haskus.Utils.Tuple.ReorderTuple (a, c, d, e) (x, y, z, w) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (x, b, y, z, w) instance Haskus.Utils.Tuple.ReorderTuple (a, b, d, e) (x, y, z, w) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (x, y, c, z, w) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, e) (x, y, z, w) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, d, w) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d) (x, y, z, w) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, w, e) instance Haskus.Utils.Tuple.ReorderTuple (b, c, d, e, f) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (a, x, y, z, w, v) instance Haskus.Utils.Tuple.ReorderTuple (a, c, d, e, f) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, b, y, z, w, v) instance Haskus.Utils.Tuple.ReorderTuple (a, b, d, e, f) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, c, z, w, v) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, e, f) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, d, w, v) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, f) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, e, v) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e) (x, y, z, w, v) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, v, f) instance Haskus.Utils.Tuple.ReorderTuple (b, c, d, e, f, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (a, x, y, z, w, v, u) instance Haskus.Utils.Tuple.ReorderTuple (a, c, d, e, f, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, b, y, z, w, v, u) instance Haskus.Utils.Tuple.ReorderTuple (a, b, d, e, f, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, c, z, w, v, u) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, e, f, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, d, w, v, u) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, f, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, e, v, u) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, g) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, v, f, u) instance Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f) (x, y, z, w, v, u) => Haskus.Utils.Tuple.ReorderTuple (a, b, c, d, e, f, g) (x, y, z, w, v, u, g) instance Haskus.Utils.Tuple.TupleCons a (Solo b) (a, b) instance Haskus.Utils.Tuple.TupleCons a (b, c) (a, b, c) instance Haskus.Utils.Tuple.TupleCons a (b, c, d) (a, b, c, d) instance Haskus.Utils.Tuple.TupleCons a (b, c, d, e) (a, b, c, d, e) instance Haskus.Utils.Tuple.TupleCons a (b, c, d, e, f) (a, b, c, d, e, f) instance Haskus.Utils.Tuple.TupleTail (a, b) (Solo b) instance Haskus.Utils.Tuple.TupleTail (a, b, c) (b, c) instance Haskus.Utils.Tuple.TupleTail (a, b, c, d) (b, c, d) instance Haskus.Utils.Tuple.TupleTail (a, b, c, d, e) (b, c, d, e) instance Haskus.Utils.Tuple.TupleTail (a, b, c, d, e, f) (b, c, d, e, f) -- | Heterogeneous list module Haskus.Utils.HList -- | Heterogeneous list data family HList (l :: [Type]) infixr 2 `HCons` -- | Head hHead :: HList (e ': l) -> e -- | Tail hTail :: HList (e ': l) -> HList l -- | Length hLength :: forall xs. KnownNat (Length xs) => HList xs -> Word hAppend :: HAppendList l1 l2 => HList l1 -> HList l2 -> HList (Concat l1 l2) -- | Like HFoldr but only use types, not values! -- -- It allows us to foldr over a list of types, without any associated -- hlist of values. class HFoldr' f v (l :: [Type]) r hFoldr' :: HFoldr' f v l r => f -> v -> HList l -> r -- | Like HFoldl but only use types, not values! -- -- It allows us to foldl over a list of types, without any associated -- hlist of values. class HFoldl' f (z :: Type) xs (r :: Type) hFoldl' :: HFoldl' f z xs r => f -> z -> HList xs -> r -- | Convert between hlists and tuples class HTuple v -- | Convert an heterogeneous list into a tuple hToTuple :: HTuple v => HList v -> Tuple v -- | Convert a tuple into an heterogeneous list hFromTuple :: HTuple v => Tuple v -> HList v -- | Apply the function identified by the data type f from type a to type -- b. class Apply f a b apply :: Apply f a b => f -> a -> b class HZipList x y l | x y -> l, l -> x y hZipList :: HZipList x y l => HList x -> HList y -> HList l class HFoldr f v (l :: [Type]) r hFoldr :: HFoldr f v l r => f -> v -> HList l -> r class HFoldl f (z :: Type) xs (r :: Type) hFoldl :: HFoldl f z xs r => f -> z -> HList xs -> r class HReverse xs sx | xs -> sx, sx -> xs hReverse :: HReverse xs sx => HList xs -> HList sx instance GHC.Classes.Eq (Haskus.Utils.HList.HList '[]) instance (GHC.Classes.Eq x, GHC.Classes.Eq (Haskus.Utils.HList.HList xs)) => GHC.Classes.Eq (Haskus.Utils.HList.HList (x : xs)) instance GHC.Classes.Ord (Haskus.Utils.HList.HList '[]) instance (GHC.Classes.Ord x, GHC.Classes.Ord (Haskus.Utils.HList.HList xs)) => GHC.Classes.Ord (Haskus.Utils.HList.HList (x : xs)) instance Haskus.Utils.HList.HTuple '[] instance Haskus.Utils.HList.HTuple '[a] instance Haskus.Utils.HList.HTuple '[a, b] instance Haskus.Utils.HList.HTuple '[a, b, c] instance Haskus.Utils.HList.HTuple '[a, b, c, d] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g, h] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g, h, i] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g, h, i, j] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g, h, i, j, k] instance Haskus.Utils.HList.HTuple '[a, b, c, d, e, f, g, h, i, j, k, l] instance (Haskus.Utils.HList.HRevApp xs '[] sx, Haskus.Utils.HList.HRevApp sx '[] xs) => Haskus.Utils.HList.HReverse xs sx instance Haskus.Utils.HList.HRevApp '[] l2 l2 instance Haskus.Utils.HList.HRevApp l (x : l') z => Haskus.Utils.HList.HRevApp (x : l) l' z instance Haskus.Utils.HList.HZipList '[] '[] '[] instance ((x, y) GHC.Types.~ z, Haskus.Utils.HList.HZipList xs ys zs) => Haskus.Utils.HList.HZipList (x : xs) (y : ys) (z : zs) instance (zx GHC.Types.~ (z, x), Haskus.Utils.HList.Apply f zx z', Haskus.Utils.HList.HFoldl' f z' xs r) => Haskus.Utils.HList.HFoldl' f z (x : xs) r instance (z GHC.Types.~ z') => Haskus.Utils.HList.HFoldl' f z '[] z' instance (zx GHC.Types.~ (z, x), Haskus.Utils.HList.Apply f zx z', Haskus.Utils.HList.HFoldl f z' xs r) => Haskus.Utils.HList.HFoldl f z (x : xs) r instance (z GHC.Types.~ z') => Haskus.Utils.HList.HFoldl f z '[] z' instance (v GHC.Types.~ v') => Haskus.Utils.HList.HFoldr' f v '[] v' instance (Haskus.Utils.HList.Apply f (e, r) r', Haskus.Utils.HList.HFoldr' f v l r) => Haskus.Utils.HList.HFoldr' f v (e : l) r' instance (v GHC.Types.~ v') => Haskus.Utils.HList.HFoldr f v '[] v' instance (Haskus.Utils.HList.Apply f (e, r) r', Haskus.Utils.HList.HFoldr f v l r) => Haskus.Utils.HList.HFoldr f v (e : l) r' instance Haskus.Utils.HList.HAppendList '[] l2 instance Haskus.Utils.HList.HAppendList l l' => Haskus.Utils.HList.HAppendList (x : l) l' instance Haskus.Utils.HList.ShowHList '[] instance (GHC.Show.Show e, Haskus.Utils.HList.ShowHList l) => Haskus.Utils.HList.ShowHList (e : l) instance Haskus.Utils.HList.ShowHList l => GHC.Show.Show (Haskus.Utils.HList.HList l)