module Data.Express.Instances
( reifyEq
, reifyOrd
, reifyEqOrd
, reifyName
, mkEq
, mkOrd
, mkOrdLessEqual
, mkName
, mkNameWith
, isEq
, isOrd
, isEqOrd
, isEqT
, isOrdT
, isEqOrdT
, mkEquation
, mkComparisonLE
, mkComparisonLT
, mkComparison
, lookupComparison
, listVarsWith
, lookupName
, lookupNames
, validApps
, findValidApp
, preludeNameInstances
)
where
import Data.Express.Basic
import Data.Express.Name
import Data.Express.Express
import Data.Express.Utils.Typeable
import Data.Express.Utils.List
import Data.Maybe
import Control.Applicative ((<$>))
reifyEq :: (Typeable a, Eq a) => a -> [Expr]
reifyEq :: forall a. (Typeable a, Eq a) => a -> [Expr]
reifyEq a
a = forall a. Typeable a => (a -> a -> Bool) -> [Expr]
mkEq (forall a. Eq a => a -> a -> Bool
(==) forall a b. (a -> b) -> a -> a -> b
-:> a
a)
reifyOrd :: (Typeable a, Ord a) => a -> [Expr]
reifyOrd :: forall a. (Typeable a, Ord a) => a -> [Expr]
reifyOrd a
a = forall a. Typeable a => (a -> a -> Ordering) -> [Expr]
mkOrd (forall a. Ord a => a -> a -> Ordering
compare forall a b. (a -> b) -> a -> a -> b
-:> a
a)
reifyEqOrd :: (Typeable a, Ord a) => a -> [Expr]
reifyEqOrd :: forall a. (Typeable a, Ord a) => a -> [Expr]
reifyEqOrd a
a = forall a. (Typeable a, Eq a) => a -> [Expr]
reifyEq a
a forall a. [a] -> [a] -> [a]
++ forall a. (Typeable a, Ord a) => a -> [Expr]
reifyOrd a
a
reifyName :: (Typeable a, Name a) => a -> [Expr]
reifyName :: forall a. (Typeable a, Name a) => a -> [Expr]
reifyName a
a = forall a. Typeable a => (a -> String) -> [Expr]
mkName (forall a. Name a => a -> String
name forall a b. (a -> b) -> a -> a -> b
-:> a
a)
mkEq :: Typeable a => (a -> a -> Bool) -> [Expr]
mkEq :: forall a. Typeable a => (a -> a -> Bool) -> [Expr]
mkEq a -> a -> Bool
(==) =
[ forall a. Typeable a => String -> a -> Expr
value String
"==" a -> a -> Bool
(==)
, forall a. Typeable a => String -> a -> Expr
value String
"/=" a -> a -> Bool
(/=)
]
where
a
x /= :: a -> a -> Bool
/= a
y = Bool -> Bool
not (a
x a -> a -> Bool
== a
y)
mkOrd :: Typeable a => (a -> a -> Ordering) -> [Expr]
mkOrd :: forall a. Typeable a => (a -> a -> Ordering) -> [Expr]
mkOrd a -> a -> Ordering
compare =
[ forall a. Typeable a => String -> a -> Expr
value String
"<=" a -> a -> Bool
(<=)
, forall a. Typeable a => String -> a -> Expr
value String
"<" a -> a -> Bool
(<)
]
where
a
x < :: a -> a -> Bool
< a
y = a
x a -> a -> Ordering
`compare` a
y forall a. Eq a => a -> a -> Bool
== Ordering
LT
a
x <= :: a -> a -> Bool
<= a
y = a
x a -> a -> Ordering
`compare` a
y forall a. Eq a => a -> a -> Bool
/= Ordering
GT
mkOrdLessEqual :: Typeable a => (a -> a -> Bool) -> [Expr]
mkOrdLessEqual :: forall a. Typeable a => (a -> a -> Bool) -> [Expr]
mkOrdLessEqual a -> a -> Bool
(<=) =
[ forall a. Typeable a => String -> a -> Expr
value String
"<=" a -> a -> Bool
(<=)
, forall a. Typeable a => String -> a -> Expr
value String
"<" a -> a -> Bool
(<)
]
where
a
x < :: a -> a -> Bool
< a
y = Bool -> Bool
not (a
y a -> a -> Bool
<= a
x)
mkName :: Typeable a => (a -> String) -> [Expr]
mkName :: forall a. Typeable a => (a -> String) -> [Expr]
mkName a -> String
name = [forall a. Typeable a => String -> a -> Expr
value String
"name" a -> String
name]
mkNameWith :: Typeable a => String -> a -> [Expr]
mkNameWith :: forall a. Typeable a => String -> a -> [Expr]
mkNameWith String
n a
a = [forall a. Typeable a => String -> a -> Expr
value String
"name" (forall a b. a -> b -> a
const String
n forall a b. (a -> b) -> a -> a -> b
-:> a
a)]
lookupComparison :: String -> TypeRep -> [Expr] -> Maybe Expr
lookupComparison :: String -> TypeRep -> [Expr] -> Maybe Expr
lookupComparison String
n' TypeRep
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\i :: Expr
i@(Value String
n Dynamic
_) -> String
n forall a. Eq a => a -> a -> Bool
== String
n' Bool -> Bool -> Bool
&& Expr -> TypeRep
typ Expr
i forall a. Eq a => a -> a -> Bool
== TypeRep -> TypeRep
mkComparisonTy TypeRep
t)
isEqT :: [Expr] -> TypeRep -> Bool
isEqT :: [Expr] -> TypeRep -> Bool
isEqT [Expr]
is TypeRep
t = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ String -> TypeRep -> [Expr] -> Maybe Expr
lookupComparison String
"==" TypeRep
t [Expr]
is
isOrdT :: [Expr] -> TypeRep -> Bool
isOrdT :: [Expr] -> TypeRep -> Bool
isOrdT [Expr]
is TypeRep
t = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ String -> TypeRep -> [Expr] -> Maybe Expr
lookupComparison String
"<=" TypeRep
t [Expr]
is
isEqOrdT :: [Expr] -> TypeRep -> Bool
isEqOrdT :: [Expr] -> TypeRep -> Bool
isEqOrdT [Expr]
is TypeRep
t = [Expr] -> TypeRep -> Bool
isEqT [Expr]
is TypeRep
t Bool -> Bool -> Bool
&& [Expr] -> TypeRep -> Bool
isOrdT [Expr]
is TypeRep
t
isEq :: [Expr] -> Expr -> Bool
isEq :: [Expr] -> Expr -> Bool
isEq [Expr]
is = [Expr] -> TypeRep -> Bool
isEqT [Expr]
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> TypeRep
typ
isOrd :: [Expr] -> Expr -> Bool
isOrd :: [Expr] -> Expr -> Bool
isOrd [Expr]
is = [Expr] -> TypeRep -> Bool
isOrdT [Expr]
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> TypeRep
typ
isEqOrd :: [Expr] -> Expr -> Bool
isEqOrd :: [Expr] -> Expr -> Bool
isEqOrd [Expr]
is Expr
e = [Expr] -> Expr -> Bool
isEq [Expr]
is Expr
e Bool -> Bool -> Bool
&& [Expr] -> Expr -> Bool
isOrd [Expr]
is Expr
e
mkComparison :: String -> [Expr] -> Expr -> Expr -> Expr
mkComparison :: String -> [Expr] -> Expr -> Expr -> Expr
mkComparison String
n' [Expr]
is Expr
e1 Expr
e2 = forall a. a -> Maybe a -> a
fromMaybe (forall a. (Typeable a, Show a) => a -> Expr
val Bool
False) forall a b. (a -> b) -> a -> b
$ do
Expr
e1e <- [Expr] -> Expr -> Maybe Expr
findValidApp [Expr]
os Expr
e1
Expr
e1e Expr -> Expr -> Maybe Expr
$$ Expr
e2
where
os :: [Expr]
os = [Expr
eq | eq :: Expr
eq@(Value String
n Dynamic
_) <- [Expr]
is, String
n forall a. Eq a => a -> a -> Bool
== String
n']
mkEquation :: [Expr] -> Expr -> Expr -> Expr
mkEquation :: [Expr] -> Expr -> Expr -> Expr
mkEquation = String -> [Expr] -> Expr -> Expr -> Expr
mkComparison String
"=="
mkComparisonLT :: [Expr] -> Expr -> Expr -> Expr
mkComparisonLT :: [Expr] -> Expr -> Expr -> Expr
mkComparisonLT = String -> [Expr] -> Expr -> Expr -> Expr
mkComparison String
"<"
mkComparisonLE :: [Expr] -> Expr -> Expr -> Expr
mkComparisonLE :: [Expr] -> Expr -> Expr -> Expr
mkComparisonLE = String -> [Expr] -> Expr -> Expr -> Expr
mkComparison String
"<="
lookupName :: [Expr] -> Expr -> String
lookupName :: [Expr] -> Expr -> String
lookupName [Expr]
is Expr
e = forall a. a -> Maybe a -> a
fromMaybe String
d forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => a -> Expr -> a
eval String
"x" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Expr -> Maybe Expr
findValidApp [Expr]
es Expr
e
where
t :: TypeRep
t = Expr -> TypeRep
typ Expr
e
d :: String
d | TypeRep -> Bool
isFunTy TypeRep
t = String
"f"
| Bool
otherwise = Char
'x' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (TypeRep -> Int
countListTy TypeRep
t) Char
's'
es :: [Expr]
es = [Expr
e | e :: Expr
e@(Value String
"name" Dynamic
_) <- [Expr]
is]
lookupNames :: [Expr] -> Expr -> [String]
lookupNames :: [Expr] -> Expr -> [String]
lookupNames [Expr]
is = String -> [String]
variableNamesFromTemplate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr -> String
lookupName [Expr]
is
listVarsWith :: [Expr] -> Expr -> [Expr]
listVarsWith :: [Expr] -> Expr -> [Expr]
listVarsWith [Expr]
is Expr
e = [Expr] -> Expr -> String
lookupName [Expr]
is Expr
e String -> Expr -> [Expr]
`listVarsAsTypeOf` Expr
e
validApps :: [Expr] -> Expr -> [Expr]
validApps :: [Expr] -> Expr -> [Expr]
validApps [Expr]
es Expr
e = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Expr -> Expr -> Maybe Expr
$$ Expr
e) [Expr]
es
findValidApp :: [Expr] -> Expr -> Maybe Expr
findValidApp :: [Expr] -> Expr -> Maybe Expr
findValidApp [Expr]
es = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr -> [Expr]
validApps [Expr]
es
(-:>) :: (a -> b) -> a -> (a -> b)
-:> :: forall a b. (a -> b) -> a -> a -> b
(-:>) = forall a b. a -> b -> a
const
infixl 1 -:>
preludeNameInstances :: [Expr]
preludeNameInstances :: [Expr]
preludeNameInstances = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: ())
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Bool)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Int)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Integer)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Char)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Ordering)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Rational)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Float)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Double)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [()])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Bool])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Int])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Integer])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Char])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Ordering])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Rational])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Float])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: [Double])
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe ())
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Bool)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Int)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Integer)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Char)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Ordering)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Rational)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Float)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Maybe Double)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: ((),()))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Bool,Bool))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Int,Int))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Integer,Integer))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Char,Char))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Ordering,Ordering))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Rational,Rational))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Float,Float))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: (Double,Double))
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: () -> ())
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Bool -> Bool)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Int -> Int)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Integer -> Integer)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Char -> Char)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Ordering -> Ordering)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Rational -> Rational)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Float -> Float)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Double -> Double)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: () -> () -> ())
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Bool -> Bool -> Bool)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Int -> Int -> Int)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Integer -> Integer -> Integer)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Char -> Char -> Char)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Ordering -> Ordering -> Ordering)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Rational -> Rational -> Rational)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Float -> Float -> Float)
, forall a. (Typeable a, Name a) => a -> [Expr]
reifyName (forall a. a
u :: Double -> Double -> Double)
]
where
u :: a
u :: forall a. a
u = forall a. HasCallStack => a
undefined