{-# LANGUAGE CPP #-}
module Data.Express.Hole
(
varAsTypeOf
, listVars
, listVarsAsTypeOf
, hole
, isHole
, hasHole
, isComplete
, holes
, nubHoles
, holeAsTypeOf
, fill
)
where
import Data.Express.Core
import Data.Dynamic
import Data.Maybe (fromMaybe)
import Data.Express.Utils.Typeable (tyArity)
import Data.Express.Utils.List (nubSort)
import Data.Express.Utils.String (variableNamesFromTemplate)
varAsTypeOf :: String -> Expr -> Expr
varAsTypeOf :: String -> Expr -> Expr
varAsTypeOf String
n Expr
e = String -> Dynamic -> Expr
Value (Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
n) (Dynamic -> Expr) -> (Expr -> Dynamic) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Dynamic
undefine (Dynamic -> Dynamic) -> (Expr -> Dynamic) -> Expr -> Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Maybe Dynamic -> Dynamic
forall a. a -> Maybe a -> a
fromMaybe Dynamic
forall {a}. a
err (Maybe Dynamic -> Dynamic)
-> (Expr -> Maybe Dynamic) -> Expr -> Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe Dynamic
toDynamic (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr
e
where
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Express.varAsTypeOf: could not compile Dynamic value for `"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' with name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n
undefine :: Dynamic -> Dynamic
#if __GLASGOW_HASKELL__ >= 806
undefine :: Dynamic -> Dynamic
undefine (Dynamic TypeRep a
t a
v) = (TypeRep a -> a -> Dynamic
forall a. TypeRep a -> a -> Dynamic
Dynamic TypeRep a
t a
forall a. HasCallStack => a
undefined)
#else
undefine = id
#endif
holeAsTypeOf :: Expr -> Expr
holeAsTypeOf :: Expr -> Expr
holeAsTypeOf = (String
"" String -> Expr -> Expr
`varAsTypeOf`)
hole :: Typeable a => a -> Expr
hole :: forall a. Typeable a => a -> Expr
hole a
a = String -> a -> Expr
forall a. Typeable a => String -> a -> Expr
var String
"" (a
forall a. HasCallStack => a
undefined a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a)
isHole :: Expr -> Bool
isHole :: Expr -> Bool
isHole (Value String
"_" Dynamic
_) = Bool
True
isHole Expr
_ = Bool
False
holes :: Expr -> [Expr]
holes :: Expr -> [Expr]
holes = (Expr -> Bool) -> [Expr] -> [Expr]
forall a. (a -> Bool) -> [a] -> [a]
filter Expr -> Bool
isHole ([Expr] -> [Expr]) -> (Expr -> [Expr]) -> Expr -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values
nubHoles :: Expr -> [Expr]
nubHoles :: Expr -> [Expr]
nubHoles = [Expr] -> [Expr]
forall a. Ord a => [a] -> [a]
nubSort ([Expr] -> [Expr]) -> (Expr -> [Expr]) -> Expr -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
holes
hasHole :: Expr -> Bool
hasHole :: Expr -> Bool
hasHole = (Expr -> Bool) -> [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Expr -> Bool
isHole ([Expr] -> Bool) -> (Expr -> [Expr]) -> Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values
isComplete :: Expr -> Bool
isComplete :: Expr -> Bool
isComplete = Bool -> Bool
not (Bool -> Bool) -> (Expr -> Bool) -> Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Bool
hasHole
listVars :: Typeable a => String -> a -> [Expr]
listVars :: forall a. Typeable a => String -> a -> [Expr]
listVars String
s a
a = (String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (String -> a -> Expr
forall a. Typeable a => String -> a -> Expr
`var` a
a) (String -> [String]
variableNamesFromTemplate String
s)
listVarsAsTypeOf :: String -> Expr -> [Expr]
listVarsAsTypeOf :: String -> Expr -> [Expr]
listVarsAsTypeOf String
s Expr
e = (String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Expr -> Expr
`varAsTypeOf` Expr
e) (String -> [String]
variableNamesFromTemplate String
s)
fill :: Expr -> [Expr] -> Expr
fill :: Expr -> [Expr] -> Expr
fill Expr
e = (Expr, [Expr]) -> Expr
forall a b. (a, b) -> a
fst ((Expr, [Expr]) -> Expr)
-> ([Expr] -> (Expr, [Expr])) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr] -> (Expr, [Expr])
fill' Expr
e
where
fill' :: Expr -> [Expr] -> (Expr,[Expr])
fill' :: Expr -> [Expr] -> (Expr, [Expr])
fill' (Expr
e1 :$ Expr
e2) [Expr]
es = let (Expr
e1',[Expr]
es') = Expr -> [Expr] -> (Expr, [Expr])
fill' Expr
e1 [Expr]
es
(Expr
e2',[Expr]
es'') = Expr -> [Expr] -> (Expr, [Expr])
fill' Expr
e2 [Expr]
es'
in (Expr
e1' Expr -> Expr -> Expr
:$ Expr
e2', [Expr]
es'')
fill' Expr
eh (Expr
e:[Expr]
es) | Expr -> Bool
isHole Expr
eh Bool -> Bool -> Bool
&& Expr -> TypeRep
typ Expr
eh TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
e = (Expr
e,[Expr]
es)
fill' Expr
e [Expr]
es = (Expr
e,[Expr]
es)