Copyright | (c) gspia 2020- |
---|---|
License | BSD |
Maintainer | gspia |
Safe Haskell | Safe |
Language | Haskell2010 |
Fcf.Alg.List
Type-level ListF
to be used with Cata, Ana and Hylo.
This module also contains other list-related functions (that might move to other place some day).
Synopsis
- data ListF a b
- data ListToFix :: [a] -> Exp (Fix (ListF a))
- data LenAlg :: Algebra (ListF a) Nat
- data SumAlg :: Algebra (ListF Nat) Nat
- data ProdAlg :: Algebra (ListF Nat) Nat
- data Sum :: [Nat] -> Exp Nat
- data Partition :: (a -> Exp Bool) -> [a] -> Exp ([a], [a])
- data PartHelp :: (a -> Exp Bool) -> a -> ([a], [a]) -> Exp ([a], [a])
- data Elem :: a -> [a] -> Exp Bool
- data Concat :: [[a]] -> Exp [a]
- data ConcatMap :: (a -> Exp [b]) -> [a] -> Exp [b]
- data Unfoldr :: (b -> Exp (Maybe (a, b))) -> b -> Exp [a]
- data UnfoldrCase :: (b -> Exp (Maybe (a, b))) -> Maybe (a, b) -> Exp [a]
Documentation
Base functor for a list of type [a]
.
data ListToFix :: [a] -> Exp (Fix (ListF a)) Source #
ListToFix can be used to turn a norma type-level list into the base
functor type ListF, to be used with e.g. Cata. For examples in use, see
LenAlg
and SumAlg
.
Ideally, we would have one ToFix type-level function for which we could give type instances for different type-level types, like lists, trees etc. See TODO.md.
data LenAlg :: Algebra (ListF a) Nat Source #
Example algebra to calculate list length.
>>>
:kind! Eval (Cata LenAlg =<< ListToFix '[1,2,3])
Eval (Cata LenAlg =<< ListToFix '[1,2,3]) :: Nat = 3
data SumAlg :: Algebra (ListF Nat) Nat Source #
Example algebra to calculate the sum of Nats in a list.
>>>
:kind! Eval (Cata SumAlg =<< ListToFix '[1,2,3,4])
Eval (Cata SumAlg =<< ListToFix '[1,2,3,4]) :: Nat = 10
data ProdAlg :: Algebra (ListF Nat) Nat Source #
Example algebra to calculate the prod of Nats in a list.
>>>
:kind! Eval (Cata ProdAlg =<< ListToFix '[1,2,3,4])
Eval (Cata ProdAlg =<< ListToFix '[1,2,3,4]) :: Nat = 24
data Sum :: [Nat] -> Exp Nat Source #
Sum a Nat-list.
Example
>>>
:kind! Eval (Sum '[1,2,3])
Eval (Sum '[1,2,3]) :: Nat = 6
data Partition :: (a -> Exp Bool) -> [a] -> Exp ([a], [a]) Source #
Partition
Example
>>>
:kind! Eval (Fcf.Alg.List.Partition ((>=) 35) '[ 20, 30, 40, 50])
Eval (Fcf.Alg.List.Partition ((>=) 35) '[ 20, 30, 40, 50]) :: ([Nat], [Nat]) = '( '[20, 30], '[40, 50])
data Elem :: a -> [a] -> Exp Bool Source #
Type-level Elem
for lists.
Example
>>>
:kind! Eval (Elem 1 '[1,2,3])
Eval (Elem 1 '[1,2,3]) :: Bool = 'True>>>
:kind! Eval (Elem 1 '[2,3])
Eval (Elem 1 '[2,3]) :: Bool = 'False
Note: Once Fcf releases a new version, I'll remove this, TODO
data Concat :: [[a]] -> Exp [a] Source #
Concat for lists.
Example
>>>
:kind! Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]]))
Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]])) :: [Nat] = '[1, 2, 3, 4, 5, 6]>>>
:kind! Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]]))
Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]])) :: [*] = '[Int, Maybe Int, Maybe String, Either Double Int]
Note: Once Fcf releases a new version, I'll remove this, TODO
data ConcatMap :: (a -> Exp [b]) -> [a] -> Exp [b] Source #
ConcatMap for lists.
Note: Once Fcf releases a new version, I'll remove this, TODO
data Unfoldr :: (b -> Exp (Maybe (a, b))) -> b -> Exp [a] Source #
Type-level Unfoldr.
Example
>>>
data ToThree :: Nat -> Exp (Maybe (Nat, Nat))
>>>
:{
type instance Eval (ToThree b) = If (Eval (b Fcf.>= 4)) 'Nothing ('Just '(b, b TL.+ 1)) :}
>>>
:kind! Eval (Unfoldr ToThree 0)
Eval (Unfoldr ToThree 0) :: [Nat] = '[0, 1, 2, 3]
Note: Once Fcf releases a new version, I'll remove this, TODO