Copyright | (c) 2019-2024 Rudy Matela |
---|---|
License | 3-Clause BSD (see the file LICENSE) |
Maintainer | Rudy Matela <rudy@matela.com.br> |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Defines utilities do deal with instances of typeclasses
Functions provided by this module store the set of instances as a simple Haskell list. When storing only a few instances this should be fine in terms of performance.
If you plan to store hundreds or thousands of instances, we recommend implementing different versions that use a more efficient Set/Map storage.
Synopsis
- reifyEq :: (Typeable a, Eq a) => a -> [Expr]
- reifyOrd :: (Typeable a, Ord a) => a -> [Expr]
- reifyEqOrd :: (Typeable a, Ord a) => a -> [Expr]
- reifyName :: (Typeable a, Name a) => a -> [Expr]
- mkEq :: Typeable a => (a -> a -> Bool) -> [Expr]
- mkOrd :: Typeable a => (a -> a -> Ordering) -> [Expr]
- mkOrdLessEqual :: Typeable a => (a -> a -> Bool) -> [Expr]
- mkName :: Typeable a => (a -> String) -> [Expr]
- mkNameWith :: Typeable a => String -> a -> [Expr]
- isEq :: [Expr] -> Expr -> Bool
- isOrd :: [Expr] -> Expr -> Bool
- isEqOrd :: [Expr] -> Expr -> Bool
- isEqT :: [Expr] -> TypeRep -> Bool
- isOrdT :: [Expr] -> TypeRep -> Bool
- isEqOrdT :: [Expr] -> TypeRep -> Bool
- mkEquation :: [Expr] -> Expr -> Expr -> Expr
- mkComparisonLE :: [Expr] -> Expr -> Expr -> Expr
- mkComparisonLT :: [Expr] -> Expr -> Expr -> Expr
- mkComparison :: String -> [Expr] -> Expr -> Expr -> Expr
- lookupComparison :: String -> TypeRep -> [Expr] -> Maybe Expr
- listVarsWith :: [Expr] -> Expr -> [Expr]
- lookupName :: [Expr] -> Expr -> String
- lookupNames :: [Expr] -> Expr -> [String]
- validApps :: [Expr] -> Expr -> [Expr]
- findValidApp :: [Expr] -> Expr -> Maybe Expr
- preludeNameInstances :: [Expr]
Documentation
reifyEq :: (Typeable a, Eq a) => a -> [Expr] Source #
O(1).
Reifies an Eq
instance into a list of Expr
s.
The list will contain ==
and /=
for the given type.
(cf. mkEq
, mkEquation
)
> reifyEq (undefined :: Int) [ (==) :: Int -> Int -> Bool , (/=) :: Int -> Int -> Bool ]
> reifyEq (undefined :: Bool) [ (==) :: Bool -> Bool -> Bool , (/=) :: Bool -> Bool -> Bool ]
> reifyEq (undefined :: String) [ (==) :: [Char] -> [Char] -> Bool , (/=) :: [Char] -> [Char] -> Bool ]
reifyOrd :: (Typeable a, Ord a) => a -> [Expr] Source #
O(1).
Reifies an Ord
instance into a list of Expr
s.
The list will contain compare
, <=
and <
for the given type.
(cf. mkOrd
, mkOrdLessEqual
, mkComparisonLE
, mkComparisonLT
)
> reifyOrd (undefined :: Int) [ (<=) :: Int -> Int -> Bool , (<) :: Int -> Int -> Bool ]
> reifyOrd (undefined :: Bool) [ (<=) :: Bool -> Bool -> Bool , (<) :: Bool -> Bool -> Bool ]
> reifyOrd (undefined :: [Bool]) [ (<=) :: [Bool] -> [Bool] -> Bool , (<) :: [Bool] -> [Bool] -> Bool ]
reifyName :: (Typeable a, Name a) => a -> [Expr] Source #
O(1).
Reifies a Name
instance into a list of Expr
s.
The list will contain name
for the given type.
(cf. mkName
, lookupName
, lookupNames
)
> reifyName (undefined :: Int) [name :: Int -> [Char]]
> reifyName (undefined :: Bool) [name :: Bool -> [Char]]
mkOrd :: Typeable a => (a -> a -> Ordering) -> [Expr] Source #
O(1).
Builds a reified Ord
instance from the given compare
function.
(cf. reifyOrd
, mkOrdLessEqual
)
mkName :: Typeable a => (a -> String) -> [Expr] Source #
O(1).
Builds a reified Name
instance from the given name
function.
(cf. reifyName
, mkNameWith
)
isEq :: [Expr] -> Expr -> Bool Source #
O(n+m).
Returns whether an Eq
instance exists in the given instances list
for the given Expr
.
> isEq (reifyEqOrd (undefined :: Int)) (val (0::Int)) True
> isEq (reifyEqOrd (undefined :: Int)) (val ([[[0::Int]]])) False
Given that the instances list has length m
and that the given Expr
has size n,
this function is O(n+m).
isOrd :: [Expr] -> Expr -> Bool Source #
O(n+m).
Returns whether an Ord
instance exists in the given instances list
for the given Expr
.
> isOrd (reifyEqOrd (undefined :: Int)) (val (0::Int)) True
> isOrd (reifyEqOrd (undefined :: Int)) (val ([[[0::Int]]])) False
Given that the instances list has length m
and that the given Expr
has size n,
this function is O(n+m).
isEqT :: [Expr] -> TypeRep -> Bool Source #
O(n).
Returns whether an Eq
instance exists in the given instances list
for the given TypeRep
.
> isEqT (reifyEqOrd (undefined :: Int)) (typeOf (undefined :: Int)) True
> isEqT (reifyEqOrd (undefined :: Int)) (typeOf (undefined :: [[[Int]]])) False
Given that the instances list has length n, this function is O(n).
isOrdT :: [Expr] -> TypeRep -> Bool Source #
O(n).
Returns whether an Ord
instance exists in the given instances list
for the given TypeRep
.
> isOrdT (reifyEqOrd (undefined :: Int)) (typeOf (undefined :: Int)) True
> isOrdT (reifyEqOrd (undefined :: Int)) (typeOf (undefined :: [[[Int]]])) False
Given that the instances list has length n, this function is O(n).
mkComparison :: String -> [Expr] -> Expr -> Expr -> Expr Source #
O(n+m).
Like mkEquation
, mkComparisonLE
and mkComparisonLT
but allows providing the binary operator name.
When not possible, this function returns False
encoded as an Expr
.
lookupComparison :: String -> TypeRep -> [Expr] -> Maybe Expr Source #
O(n).
Lookups for a comparison function (:: a -> a -> Bool
)
with the given name and argument type.
listVarsWith :: [Expr] -> Expr -> [Expr] Source #
O(n+m).
Like lookupNames
but returns a list of variables encoded as Expr
s.
lookupNames :: [Expr] -> Expr -> [String] Source #
O(n+m).
A mix between lookupName
and names
:
this returns an infinite list of names
based on an instances list and an Expr
.