Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
This module provides functions to modify Symbol
s and type-level lists.
The workflow to define a modification function can be as follows.
- Use
ToList
to convert aSymbol
to a type-level list ofChar
s. - Use functions from here and from the package first-class-families for type-level lists (
Fcf.Data.List
). - Use
FromList
to convert a type-level list ofChar
s back to aSymbol
.
Example (see DropPrefix
):
>>>
:kind! DropPrefix "_userParams_category"
DropPrefix "_userParams_category" :: Symbol = "category"
Modules that use the Eval
type family (e.g., Servant.Record) must be imported together with modules that export instances of Eval
(see the GHC
documentation on Type families).
Synopsis
- type family Eval (e :: Exp a) :: a
- type Exp a = a -> Type
- type family FromList (cs :: [Char]) :: Symbol where ...
- type family FromList1 (syms :: [Char]) (sym :: Symbol) :: Symbol where ...
- type family ToList (sym :: Symbol) :: [Char] where ...
- type family ToList1 (sym :: Maybe (Char, Symbol)) :: [Char] where ...
- data TyEq (c :: a) (d :: b) (e :: Bool)
- data NotTyEq :: a -> b -> Exp Bool
- type DropUnderscores = DropWhile (TyEq '_')
- type DropNonUnderscores = DropWhile (NotTyEq '_')
- type family DropPrefix (sym :: Symbol) :: Symbol where ...
Re-exports from first-class-families
type family Eval (e :: Exp a) :: a #
Expression evaluator.
Instances
type Eval (Not 'False) | |
Defined in Fcf.Data.Bool | |
type Eval (Not 'True) | |
Defined in Fcf.Data.Bool | |
type Eval (Constraints (a ': as) :: Constraint -> Type) | |
Defined in Fcf.Utils | |
type Eval (Constraints ('[] :: [Constraint])) | |
Defined in Fcf.Utils | |
type Eval (MEmpty_ :: a -> Type) | |
Defined in Fcf.Class.Monoid | |
type Eval (Sum ns :: Nat -> Type) | |
type Eval (Length ('[] :: [a]) :: Nat -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Length (a2 ': as) :: Nat -> Type) | |
type Eval (a * b :: Nat -> Type) | |
type Eval (a + b :: Nat -> Type) | |
type Eval (a - b :: Nat -> Type) | |
type Eval (a ^ b :: Nat -> Type) | |
type Eval (And lst :: Bool -> Type) | |
type Eval (Or lst :: Bool -> Type) | |
type Eval ('False && b :: Bool -> Type) | |
type Eval ('True && b :: Bool -> Type) | |
type Eval (a && 'False :: Bool -> Type) | |
type Eval (a && 'True :: Bool -> Type) | |
type Eval ('False || b :: Bool -> Type) | |
type Eval ('True || b :: Bool -> Type) | |
type Eval (a || 'False :: Bool -> Type) | |
type Eval (a || 'True :: Bool -> Type) | |
type Eval (IsJust ('Just _a) :: Bool -> Type) | |
type Eval (IsJust ('Nothing :: Maybe a) :: Bool -> Type) | |
type Eval (IsNothing ('Just _a) :: Bool -> Type) | |
type Eval (IsNothing ('Nothing :: Maybe a) :: Bool -> Type) | |
type Eval (Null ('[] :: [a]) :: Bool -> Type) | |
type Eval (Null (a2 ': as) :: Bool -> Type) | |
type Eval (a < b :: Bool -> Type) | |
type Eval (a <= b :: Bool -> Type) | |
type Eval (a > b :: Bool -> Type) | |
type Eval (a >= b :: Bool -> Type) | |
type Eval (Join e :: a -> Type) | |
type Eval (Pure x :: a -> Type) | |
Defined in Fcf.Combinators | |
type Eval (Error msg :: a -> Type) | |
type Eval (TError msg :: a -> Type) | |
type Eval (IsLeft ('Left _a :: Either a b) :: Bool -> Type) | |
type Eval (IsLeft ('Right _a :: Either a b) :: Bool -> Type) | |
type Eval (IsRight ('Left _a :: Either a b) :: Bool -> Type) | |
type Eval (IsRight ('Right _a :: Either a b) :: Bool -> Type) | |
type Eval (Elem a2 as :: Bool -> Type) | |
type Eval (IsInfixOf xs ys :: Bool -> Type) | |
type Eval (IsPrefixOf xs ys :: Bool -> Type) | |
Defined in Fcf.Data.List | |
type Eval (IsSuffixOf xs ys :: Bool -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Concat xs :: a -> Type) | |
type Eval (x .<> y :: a -> Type) | |
Defined in Fcf.Class.Monoid | |
type Eval (FromMaybe _a ('Just b) :: a -> Type) | |
Defined in Fcf.Data.Common | |
type Eval (FromMaybe a2 ('Nothing :: Maybe a1) :: a1 -> Type) | |
type Eval (Fst '(a2, _b) :: a1 -> Type) | |
Defined in Fcf.Data.Common | |
type Eval (Snd '(_a, b) :: a1 -> Type) | |
Defined in Fcf.Data.Common | |
type Eval (All p lst :: Bool -> Type) | |
type Eval (Any p lst :: Bool -> Type) | |
type Eval (TyEq a b :: Bool -> Type) | |
type Eval (NotTyEq a b :: Bool -> Type) Source # | |
Defined in Servant.TypeLevel | |
type Eval (UnBool fal tru 'False :: a -> Type) | |
type Eval (UnBool fal tru 'True :: a -> Type) | |
type Eval (f $ a3 :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (f <$> e :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (f <*> e :: a1 -> Type) | |
type Eval (k =<< e :: a1 -> Type) | |
type Eval (e >>= k :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (ConstFn a2 _b :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (Pure1 f x :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (x & f :: a1 -> Type) | |
Defined in Fcf.Data.Function | |
type Eval (Case ms a :: k -> Type) | |
type Eval (FoldMap f ('Left _a :: Either a3 a2) :: a1 -> Type) | |
type Eval (FoldMap f ('Right x :: Either a3 a2) :: a1 -> Type) | |
type Eval (FoldMap f ('Just x) :: a1 -> Type) | |
type Eval (FoldMap f ('Nothing :: Maybe a2) :: a1 -> Type) | |
type Eval (FoldMap f (x ': xs) :: a1 -> Type) | |
type Eval (FoldMap f ('[] :: [a2]) :: a1 -> Type) | |
Defined in Fcf.Class.Foldable | |
type Eval (UnMaybe y f ('Just x) :: a1 -> Type) | |
type Eval (UnMaybe y f ('Nothing :: Maybe a2) :: a1 -> Type) | |
type Eval (Uncurry f '(x, y) :: a1 -> Type) | |
Defined in Fcf.Data.Common | |
type Eval (UnList y f xs :: a1 -> Type) | |
type Eval (Foldr f y ('Left _a :: Either a3 a2) :: a1 -> Type) | |
type Eval (Foldr f y ('Right x :: Either a3 a2) :: a1 -> Type) | |
type Eval (Foldr f y ('Just x) :: a1 -> Type) | |
type Eval (Foldr f y ('Nothing :: Maybe a2) :: a1 -> Type) | |
type Eval (Foldr f y (x ': xs) :: a1 -> Type) | |
type Eval (Foldr f y ('[] :: [a2]) :: a1 -> Type) | |
Defined in Fcf.Class.Foldable | |
type Eval ((f <=< g) x :: a1 -> Type) | |
type Eval (Flip f y x :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (LiftM2 f x y :: a1 -> Type) | |
type Eval (Pure2 f x y :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (UnEither f g ('Left x :: Either a2 b) :: a1 -> Type) | |
type Eval (UnEither f g ('Right y :: Either a2 b) :: a1 -> Type) | |
type Eval (On r f x y :: a1 -> Type) | |
type Eval (LiftM3 f x y z :: a1 -> Type) | |
type Eval (Pure3 f x y z :: a1 -> Type) | |
Defined in Fcf.Combinators | |
type Eval (Bicomap f g r x y :: a1 -> Type) | |
type Eval (Init ('[] :: [a]) :: Maybe [a] -> Type) | |
type Eval (Tail (_a ': as) :: Maybe [a] -> Type) | |
type Eval (Tail ('[] :: [a]) :: Maybe [a] -> Type) | |
type Eval (Init (a2 ': (b ': as)) :: Maybe [a1] -> Type) | |
type Eval (Init '[a2] :: Maybe [a1] -> Type) | |
type Eval (Head ('[] :: [a]) :: Maybe a -> Type) | |
type Eval (Last ('[] :: [a]) :: Maybe a -> Type) | |
type Eval (Head (a2 ': _as) :: Maybe a1 -> Type) | |
type Eval (Last (a2 ': (b ': as)) :: Maybe a1 -> Type) | |
type Eval (Last '[a2] :: Maybe a1 -> Type) | |
type Eval (Tails ('[] :: [a]) :: [[a]] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Tails (a2 ': as) :: [[a1]] -> Type) | |
type Eval (Reverse l :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (FindIndex _p ('[] :: [a]) :: Maybe Nat -> Type) | |
type Eval (FindIndex p (a2 ': as) :: Maybe Nat -> Type) | |
type Eval (NumIter a s :: Maybe (k, Nat) -> Type) | |
type Eval (Find _p ('[] :: [a]) :: Maybe a -> Type) | |
type Eval (Find p (a2 ': as) :: Maybe a1 -> Type) | |
type Eval (xs ++ ys :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Drop n as :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (DropWhile p (x ': xs) :: [a] -> Type) | |
type Eval (DropWhile p ('[] :: [a]) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Filter _p ('[] :: [a]) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Intercalate xs xss :: [a] -> Type) | |
Defined in Fcf.Data.List type Eval (Intercalate xs xss :: [a] -> Type) = Eval ((Concat :: [[a]] -> [a] -> Type) =<< Intersperse xs xss) | |
type Eval (Intersperse _1 ('[] :: [a]) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Intersperse sep (x ': xs) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (PrependToAll _1 ('[] :: [a]) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (PrependToAll sep (x ': xs) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Rev (x ': xs) ys :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Rev ('[] :: [a]) ys :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Take n as :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (TakeWhile p (x ': xs) :: [a] -> Type) | |
type Eval (TakeWhile p ('[] :: [a]) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Cons a2 as :: [a1] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Filter p (a2 ': as) :: [a1] -> Type) | |
type Eval (Replicate n a2 :: [a1] -> Type) | |
type Eval (Snoc lst a :: [k] -> Type) | |
type Eval (Lookup a as :: Maybe b -> Type) | |
type Eval (Zip as bs :: [(a, b)] -> Type) | |
type Eval (Unfoldr f c :: [a] -> Type) | |
type Eval (UnfoldrCase _1 ('Nothing :: Maybe (a, b)) :: [a] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (UnfoldrCase f ('Just ab) :: [a1] -> Type) | |
type Eval (SetIndex n a' as :: [k] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Map f ('Just a3) :: Maybe a1 -> Type) | |
type Eval (Map f ('Nothing :: Maybe a) :: Maybe b -> Type) | |
type Eval (ConcatMap f xs :: [b] -> Type) | |
type Eval (Map f ('[] :: [a]) :: [b] -> Type) | |
Defined in Fcf.Class.Functor | |
type Eval (Map f (a2 ': as) :: [b] -> Type) | |
type Eval (ZipWith _f ('[] :: [a]) _bs :: [c] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (ZipWith _f _as ('[] :: [b]) :: [c] -> Type) | |
Defined in Fcf.Data.List | |
type Eval (ZipWith f (a2 ': as) (b2 ': bs) :: [c] -> Type) | |
type Eval (Break p lst :: ([a], [a]) -> Type) | |
type Eval (Partition p lst :: ([a], [a]) -> Type) | |
type Eval (Span p lst :: ([a], [a]) -> Type) | |
type Eval (Unzip as :: ([a], [b]) -> Type) | |
type Eval (PartHelp p a2 '(xs, ys) :: ([a1], [a1]) -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Cons2 '(a3, b) '(as, bs) :: ([a1], [a2]) -> Type) | |
Defined in Fcf.Data.List | |
type Eval (Map f ('Left x :: Either a1 a2) :: Either a1 b -> Type) | |
type Eval (Map f ('Right a3 :: Either a1 a2) :: Either a1 b -> Type) | |
type Eval (Map f '(x, a2) :: (k1, k2) -> Type) | |
Defined in Fcf.Class.Functor | |
type Eval ((f *** f') '(b2, b'2) :: (k1, k2) -> Type) | |
type Eval (Second g x :: f a' b' -> Type) | |
type Eval (First f2 x :: f1 a' b' -> Type) | |
type Eval (Bimap f g ('Right y :: Either a b2) :: Either a' b1 -> Type) | |
type Eval (Bimap f g ('Left x :: Either a2 b) :: Either a1 b' -> Type) | |
type Eval (Bimap f g '(x, y) :: (k1, k2) -> Type) | |
type Eval (Map f '(x, y, a2) :: (k1, k2, k3) -> Type) | |
Defined in Fcf.Class.Functor | |
type Eval (Map f '(x, y, z, a2) :: (k1, k2, k3, k4) -> Type) | |
Defined in Fcf.Class.Functor | |
type Eval (Map f '(x, y, z, w, a2) :: (k1, k2, k3, k4, k5) -> Type) | |
Defined in Fcf.Class.Functor |
List functions
type family FromList (cs :: [Char]) :: Symbol where ... Source #
type family FromList1 (syms :: [Char]) (sym :: Symbol) :: Symbol where ... Source #
Convert a list of Char
s to a Symbol
.
In this list, Chars
go in a reverse order.
>>>
:kind! FromList1 ['a', 'b', 'c'] ""
FromList1 ['a', 'b', 'c'] "" :: Symbol = "cba"
FromList1 '[] s = s | |
FromList1 (x ': xs) s = FromList1 xs (ConsSymbol x s) |
type family ToList (sym :: Symbol) :: [Char] where ... Source #
ToList sym = ToList1 (UnconsSymbol sym) |
Comparison functions
Examples
type DropUnderscores = DropWhile (TyEq '_') Source #
Drop leading underscores.
>>>
:kind! Eval (DropUnderscores ['_', '_', 'a'])
Eval (DropUnderscores ['_', '_', 'a']) :: [Char] = '['a']
type DropNonUnderscores = DropWhile (NotTyEq '_') Source #
Drop leading non-underscores.
>>>
:kind! Eval (DropNonUnderscores ['a', 'a', '_'])
Eval (DropNonUnderscores ['a', 'a', '_']) :: [Char] = '['_']
type family DropPrefix (sym :: Symbol) :: Symbol where ... Source #
Drop the prefix of a Symbol
.
>>>
:kind! DropPrefix "_userParams_category"
DropPrefix "_userParams_category" :: Symbol = "category"
DropPrefix sym = FromList (Eval (DropUnderscores (Eval (DropNonUnderscores (Eval (DropUnderscores (ToList sym))))))) |