git.iko.soy/elk
on master help sign in
restrict incoming ports to disallow data structures that contain signals, only "top-level" signals are allowed
1a1aff1Evan Czaplicki
compiler/Type/ExtraChecks.hs+9−5
compare with master
unifiedsplit
@@ -49,9 +49,8 @@ portTypes :: Alias.Rules -> E.LExpr -> Either [P.Doc] ()
49portTypes rules expr =
49portTypes rules expr =
50 const () <$> Expr.checkPorts (check In) (check Out) expr
50 const () <$> Expr.checkPorts (check In) (check Out) expr
51 where
51 where
52− check = isValid False False
52+ check = isValid True False False
53− isValid seenFunc seenSignal direction name tipe =
53+ isValid isTopLevel seenFunc seenSignal direction name tipe =
54− let valid = isValid seenFunc seenSignal direction name in
55 case tipe of
54 case tipe of
56 T.Data ctor ts
55 T.Data ctor ts
57 | isJs ctor || isElm ctor -> mapM_ valid ts
56 | isJs ctor || isElm ctor -> mapM_ valid ts
@@ -66,7 +65,8 @@ portTypes rules expr =
66 Out | seenFunc -> err "higher-order functions"
65 Out | seenFunc -> err "higher-order functions"
67 | seenSignal -> err "signals that contain functions"
66 | seenSignal -> err "signals that contain functions"
68 | otherwise ->
67 | otherwise ->
68+ forM_ (T.collectLambdas tipe)
69− mapM_ (isValid True seenSignal direction name) (T.collectLambdas tipe)
69+ (isValid' True seenSignal direction name)
70
70
71 T.Record _ (Just _) -> err "extended records with free type variables"
71 T.Record _ (Just _) -> err "extended records with free type variables"
72
72
@@ -74,6 +74,9 @@ portTypes rules expr =
74 mapM_ (\(k,v) -> (,) k <$> valid v) fields
74 mapM_ (\(k,v) -> (,) k <$> valid v) fields
75
75
76 where
76 where
77+ isValid' = isValid False
78+ valid = isValid' seenFunc seenSignal direction name
79+
77 isJs ctor =
80 isJs ctor =
78 List.isPrefixOf "JavaScript." ctor
81 List.isPrefixOf "JavaScript." ctor
79 && length (filter (=='.') ctor) == 1
82 && length (filter (=='.') ctor) == 1
@@ -85,7 +88,8 @@ portTypes rules expr =
85 handleSignal ts
88 handleSignal ts
86 | seenFunc = err "functions that involve signals"
89 | seenFunc = err "functions that involve signals"
87 | seenSignal = err "signals-of-signals"
90 | seenSignal = err "signals-of-signals"
88− | otherwise = mapM_ (isValid seenFunc True direction name) ts
91+ | isTopLevel = mapM_ (isValid' seenFunc True direction name) ts
92+ | otherwise = err "a signal within a data stucture"
89
93
90 dir inMsg outMsg = case direction of { In -> inMsg ; Out -> outMsg }
94 dir inMsg outMsg = case direction of { In -> inMsg ; Out -> outMsg }
91 txt = P.text . concat
95 txt = P.text . concat