summaryrefslogtreecommitdiff
path: root/src/Script
diff options
context:
space:
mode:
Diffstat (limited to 'src/Script')
-rw-r--r--src/Script/Expr.hs13
-rw-r--r--src/Script/Expr/Class.hs12
2 files changed, 20 insertions, 5 deletions
diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs
index bc4f9cb..cc37f73 100644
--- a/src/Script/Expr.hs
+++ b/src/Script/Expr.hs
@@ -253,8 +253,10 @@ newtype TypeVar = TypeVar Text
data SomeExprType
= forall a. ExprType a => ExprTypePrim (Proxy a)
+ | forall a. ExprTypeConstr1 a => ExprTypeConstr1 (Proxy a)
| ExprTypeVar TypeVar
| forall a. ExprType a => ExprTypeFunction (FunctionArguments SomeArgumentType) (Proxy a)
+ | ExprTypeApp SomeExprType [ SomeExprType ]
someExprType :: SomeExpr -> SomeExprType
someExprType (SomeExpr expr) = go expr
@@ -285,9 +287,14 @@ someExprType (SomeExpr expr) = go expr
proxyOfFunctionType _ = Proxy
textSomeExprType :: SomeExprType -> Text
-textSomeExprType (ExprTypePrim p) = textExprType p
-textSomeExprType (ExprTypeVar (TypeVar name)) = name
-textSomeExprType (ExprTypeFunction _ r) = "function:" <> textExprType r
+textSomeExprType = go []
+ where
+ go _ (ExprTypePrim p) = textExprType p
+ go (x : _) (ExprTypeConstr1 c) = textExprTypeConstr1 c x
+ go [] (ExprTypeConstr1 _) = "<incomplte type>"
+ go _ (ExprTypeVar (TypeVar name)) = name
+ go _ (ExprTypeFunction _ r) = "function:" <> textExprType r
+ go _ (ExprTypeApp c xs) = go (map textSomeExprType xs) c
data AsFunType a
= forall b. (a ~ FunctionType b, ExprType b) => IsFunType
diff --git a/src/Script/Expr/Class.hs b/src/Script/Expr/Class.hs
index 810b0c8..fd128f1 100644
--- a/src/Script/Expr/Class.hs
+++ b/src/Script/Expr/Class.hs
@@ -1,10 +1,12 @@
module Script.Expr.Class (
ExprType(..),
+ ExprTypeConstr1(..),
RecordSelector(..),
ExprListUnpacker(..),
ExprEnumerator(..),
) where
+import Data.Kind
import Data.Maybe
import Data.Scientific
import Data.Text (Text)
@@ -31,6 +33,9 @@ class Typeable a => ExprType a where
exprEnumerator :: proxy a -> Maybe (ExprEnumerator a)
exprEnumerator _ = Nothing
+class (forall b. ExprType b => ExprType (a b)) => ExprTypeConstr1 (a :: Type -> Type) where
+ textExprTypeConstr1 :: proxy a -> Text -> Text
+
data RecordSelector a = forall b. ExprType b => RecordSelector (a -> b)
@@ -74,12 +79,15 @@ instance ExprType Void where
textExprType _ = T.pack "void"
textExprValue _ = T.pack "<void>"
-instance ExprType a => ExprType [a] where
- textExprType _ = "[" <> textExprType @a Proxy <> "]"
+instance ExprType a => ExprType [ a ] where
+ textExprType _ = textExprTypeConstr1 @[] Proxy (textExprType @a Proxy)
textExprValue x = "[" <> T.intercalate ", " (map textExprValue x) <> "]"
exprListUnpacker _ = Just $ ExprListUnpacker id (const Proxy)
+instance ExprTypeConstr1 [] where
+ textExprTypeConstr1 _ x = "[" <> x <> "]"
+
instance ExprType a => ExprType (Maybe a) where
textExprType _ = textExprType @a Proxy <> "?"
textExprValue (Just x) = textExprValue x