github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Throw instead of failing for bad pair value

Browse Source
This commit is contained in:
Timothy Clem 2018-04-17 11:43:02 -07:00
parent 4e57c57085
commit d4769e41ba
3 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Analysis/Abstract/BadValues.hs
View File

@ -37,6 +37,7 @@ instance ( Effectful m
BoolError{} -> yield True
Numeric2Error{} -> unit >>= yield
NamespaceError{} -> getEnv >>= yield
KeyValueError{} -> unit >>= \x -> yield (x, x)
)
analyzeModule = liftAnalyze analyzeModule

1
src/Control/Abstract/Value.hs
View File

@ -195,6 +195,7 @@ data ValueError location value resume where
CallError :: value -> ValueError location value value
BoolError :: value -> ValueError location value Bool
Numeric2Error :: value -> value -> ValueError location value value
KeyValueError :: value -> ValueError location value (value, value)
instance Eq value => Eq1 (ValueError location value) where
liftEq _ (StringError a) (StringError b) = a == b

6
src/Data/Abstract/Value.hs
View File

@ -206,9 +206,9 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
null = pure . injValue $ Null
asPair k
| Just (KVPair k v) <- prjValue k = pure (k, v)
| otherwise = fail ("expected key-value pair, got " <> show k)
asPair val
| Just (KVPair k v) <- prjValue val = pure (k, v)
| otherwise = throwException @(ValueError location (Value location)) $ KeyValueError val
hash = pure . injValue . Hash . fmap (injValue . uncurry KVPair)