Copyright | (c) 2019-2021 Rudy Matela |
---|---|
License | 3-Clause BSD (see the file LICENSE) |
Maintainer | Rudy Matela <rudy@matela.com.br> |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Defines the Express
type class.
Synopsis
- class (Show a, Typeable a) => Express a where
- (-:) :: a -> a -> a
- (->:) :: (a -> b) -> b -> a -> b
- (->>:) :: (a -> b -> c) -> c -> a -> b -> c
- (->>>:) :: (a -> b -> c -> d) -> d -> a -> b -> c -> d
- (->>>>:) :: (a -> b -> c -> d -> e) -> e -> a -> b -> c -> d -> e
- (->>>>>:) :: (a -> b -> c -> d -> e -> f) -> f -> a -> b -> c -> d -> e -> f
- (->>>>>>:) :: (a -> b -> c -> d -> e -> f -> g) -> g -> a -> b -> c -> d -> e -> f -> g
- (->>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h) -> h -> a -> b -> c -> d -> e -> f -> g -> h
- (->>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> i -> a -> b -> c -> d -> e -> f -> g -> h -> i
- (->>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
- (->>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
- (->>>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> l -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
- (->>>>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) -> m -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
Documentation
class (Show a, Typeable a) => Express a where Source #
Express
typeclass instances provide an expr
function
that allows values to be deeply encoded as applications of Expr
s.
expr False = val False expr (Just True) = value "Just" (Just :: Bool -> Maybe Bool) :$ val True
The function expr
can be contrasted with the function val
:
val
always encodes values as atomicValue
Expr
s -- shallow encoding.expr
ideally encodes expressions as applications (:$
) betweenValue
Expr
s -- deep encoding.
Depending on the situation, one or the other may be desirable.
Instances can be automatically derived using the TH function
deriveExpress
.
The following example shows a datatype and its instance:
data Stack a = Stack a (Stack a) | Empty
instance Express a => Express (Stack a) where expr s@(Stack x y) = value "Stack" (Stack ->>: s) :$ expr x :$ expr y expr s@Empty = value "Empty" (Empty -: s)
To declare expr
it may be useful to use auxiliary type binding operators:
-:
, ->:
, ->>:
, ->>>:
, ->>>>:
, ->>>>>:
, ...
For types with atomic values, just declare expr = val
Instances
(-:) :: a -> a -> a infixl 1 Source #
Type restricted version of const
that forces its first argument
to have the same type as the second.
value -: (undefined :: Ty) = value :: Ty
(->:) :: (a -> b) -> b -> a -> b infixl 1 Source #
Type restricted version of const
that forces the result of its first argument
to have the same type as the second.
f ->: (undefined :: Ty) = f :: a -> Ty
(->>:) :: (a -> b -> c) -> c -> a -> b -> c infixl 1 Source #
Type restricted version of const
that forces the result of the result of its first argument
to have the same type as the second.
f ->>: (undefined :: Ty) = f :: a -> b -> Ty
(->>>:) :: (a -> b -> c -> d) -> d -> a -> b -> c -> d infixl 1 Source #
Type restricted version of const
that forces the result of the result of the result of its first argument
to have the same type as the second.
(->>>>:) :: (a -> b -> c -> d -> e) -> e -> a -> b -> c -> d -> e infixl 1 Source #
Forces the result type of a 4-argument function.
(->>>>>:) :: (a -> b -> c -> d -> e -> f) -> f -> a -> b -> c -> d -> e -> f infixl 1 Source #
Forces the result type of a 5-argument function.
(->>>>>>:) :: (a -> b -> c -> d -> e -> f -> g) -> g -> a -> b -> c -> d -> e -> f -> g infixl 1 Source #
Forces the result type of a 6-argument function.
(->>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h) -> h -> a -> b -> c -> d -> e -> f -> g -> h infixl 1 Source #
Forces the result type of a 7-argument function.
(->>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> i -> a -> b -> c -> d -> e -> f -> g -> h -> i infixl 1 Source #
Forces the result type of a 8-argument function.
(->>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j infixl 1 Source #
Forces the result type of a 9-argument function.
(->>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k infixl 1 Source #
Forces the result type of a 10-argument function.
(->>>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) -> l -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l infixl 1 Source #
Forces the result type of a 11-argument function.
(->>>>>>>>>>>>:) :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) -> m -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m infixl 1 Source #
Forces the result type of a 12-argument function.