From 915937c4be388c6e0af6a7dfe0dc883380d1b010 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 16 Jun 2019 13:00:47 +0200 Subject: [PATCH 1/2] Fix some hlint warnings --- .hlint.yaml | 2 +- semantic-core/src/Analysis/Concrete.hs | 2 +- semantic-core/src/Analysis/Eval.hs | 2 +- semantic-core/src/Analysis/Typecheck.hs | 2 +- semantic-core/src/Control/Effect/Readline.hs | 2 +- semantic-core/test/Spec.hs | 2 +- src/Data/Language.hs | 2 +- src/Data/Project.hs | 2 +- src/Semantic/Git.hs | 4 ++-- src/Tags/Taggable.hs | 2 +- test/Analysis/Go/Spec.hs | 6 +++--- test/Analysis/PHP/Spec.hs | 12 ++++++------ test/Analysis/Python/Spec.hs | 14 +++++++------- test/Analysis/Ruby/Spec.hs | 6 +++--- test/Analysis/TypeScript/Spec.hs | 12 ++++++------ test/Data/Scientific/Spec.hs | 3 ++- test/Examples.hs | 2 +- test/Numeric/Spec.hs | 3 ++- test/Rewriting/JSON/Spec.hs | 2 +- 19 files changed, 42 insertions(+), 40 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 2b89659d7b..e8e2be0e8a 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -67,7 +67,7 @@ # Conveniences - warning: {lhs: maybe a pure, rhs: maybeM a, name: Use maybeM} - warning: {lhs: either (const a) id, rhs: fromRight a, name: use fromRight} -- warning: {lhs: either id (const a), rhs: fromLeft a, name: use fromRight} +- warning: {lhs: either id (const a), rhs: fromLeft a, name: use fromLeft} # Applicative style - warning: {lhs: f <$> pure a <*> b, rhs: f a <$> b, name: Avoid redundant pure} diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs index cb76d3a69d..90c9bb4a90 100644 --- a/semantic-core/src/Analysis/Concrete.hs +++ b/semantic-core/src/Analysis/Concrete.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, RecordWildCards, TypeOperators, UndecidableInstances #-} module Analysis.Concrete ( Concrete(..) , concrete diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs index 4e296e9a32..64b0425d52 100644 --- a/semantic-core/src/Analysis/Eval.hs +++ b/semantic-core/src/Analysis/Eval.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase, RankNTypes, RecordWildCards #-} +{-# LANGUAGE FlexibleContexts, LambdaCase, RankNTypes, RecordWildCards #-} module Analysis.Eval ( eval , prog1 diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs index 0fd2fe4457..7f35cc011f 100644 --- a/semantic-core/src/Analysis/Typecheck.hs +++ b/semantic-core/src/Analysis/Typecheck.hs @@ -160,7 +160,7 @@ typecheckingAnalysis = Analysis{..} bool _ = pure MBool asBool b = unify MBool b >> pure True <|> pure False string _ = pure MString - asString s = unify MString s *> pure "" + asString s = unify MString s $> "" frame = fail "unimplemented" edge _ _ = pure () _ ... m = m diff --git a/semantic-core/src/Control/Effect/Readline.hs b/semantic-core/src/Control/Effect/Readline.hs index b25b4f2856..0d76916ebc 100644 --- a/semantic-core/src/Control/Effect/Readline.hs +++ b/semantic-core/src/Control/Effect/Readline.hs @@ -81,7 +81,7 @@ instance (Carrier sig m, Effect sig, MonadException m, MonadIO m) => Carrier (Re runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a runReadlineWithHistory block = do - homeDir <- liftIO $ getHomeDirectory + homeDir <- liftIO getHomeDirectory prefs <- liftIO $ readPrefs (homeDir ".haskeline") let settingsDir = homeDir ".local/semantic-core" settings = Settings diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs index edc49efb0e..678c446ee9 100644 --- a/semantic-core/test/Spec.hs +++ b/semantic-core/test/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 6af5e0bb0c..56386933b7 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures #-} module Data.Language ( Language (..) , SLanguage (..) diff --git a/src/Data/Project.hs b/src/Data/Project.hs index fefcf839d5..e7cd935c25 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, KindSignatures, MultiWayIf #-} +{-# LANGUAGE DeriveAnyClass, MultiWayIf #-} module Data.Project ( Project (..) diff --git a/src/Semantic/Git.hs b/src/Semantic/Git.hs index c6dad92141..4923dcb0ce 100644 --- a/src/Semantic/Git.hs +++ b/src/Semantic/Git.hs @@ -19,6 +19,7 @@ import Control.Monad.IO.Class import Data.Attoparsec.Text (Parser) import Data.Attoparsec.Text as AP import Data.Char +import Data.Either (fromRight) import Data.Text as Text import Shelly hiding (FilePath) import System.IO (hSetBinaryMode) @@ -42,7 +43,7 @@ sh = shelly . silently . onCommandHandles (initOutputHandles (`hSetBinaryMode` T -- | Parses an list of entries separated by \NUL, and on failure return [] parseEntries :: Text -> [TreeEntry] -parseEntries = either (const []) id . AP.parseOnly everything +parseEntries = fromRight [] . AP.parseOnly everything where everything = AP.sepBy entryParser "\NUL" <* "\NUL\n" <* AP.endOfInput @@ -87,4 +88,3 @@ data TreeEntry , treeEntryOid :: OID , treeEntryPath :: FilePath } deriving (Eq, Show) - diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index 7bb8e1e898..ad27cdf08e 100644 --- a/src/Tags/Taggable.hs +++ b/src/Tags/Taggable.hs @@ -189,7 +189,7 @@ instance Taggable Expression.Call where instance Taggable Ruby.Send where snippet ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = Just $ subtractLocation ann body snippet ann _ = Just $ locationByteRange ann - symbolName Ruby.Send{..} = maybe Nothing declaredName sendSelector + symbolName Ruby.Send{..} = declaredName =<< sendSelector instance Taggable [] instance Taggable Comment.Comment diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 6510f52cf6..3cfe5e2b68 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -4,7 +4,7 @@ module Analysis.Go.Spec (spec) where import qualified Data.Abstract.ModuleTable as ModuleTable import qualified Data.Language as Language -import SpecHelpers +import SpecHelpers spec :: (?session :: TaskSession) => Spec @@ -25,8 +25,8 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main1.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"] case ModuleTable.lookup "main1.go" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "f" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "f" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldBe` Just () -- (lookupDeclaration "f" heap >>= deNamespace heap) `shouldBe` Just ("f", ["New"]) other -> expectationFailure (show other) diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index b59418c842..4ee06932e2 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -16,8 +16,8 @@ spec = parallel $ do case ModuleTable.lookup "main.php" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Unit - const () <$> SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) xit "evaluates include_once and require_once" $ do @@ -25,16 +25,16 @@ spec = parallel $ do case ModuleTable.lookup "main_once.php" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Unit - const () <$> SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) xit "evaluates namespaces" $ do (scopeGraph, (heap, res)) <- evaluate ["namespaces.php"] case ModuleTable.lookup "namespaces.php" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "NS1" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "NS1" scopeAndFrame heap scopeGraph `shouldBe` Just () undefined -- (derefQName heap ("NS1" :| []) env >>= deNamespace heap) `shouldBe` Just ("NS1", ["Sub1", "b", "c"]) diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 9d43baf0da..bc0ea22817 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -16,8 +16,8 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "a" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "a" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () fromJust (SpecHelpers.lookupMembers "a" Import scopeAndFrame heap scopeGraph) `shouldContain` [ "foo" ] fromJust (SpecHelpers.lookupMembers "b" Import scopeAndFrame heap scopeGraph) `shouldContain` ["c"] @@ -28,16 +28,16 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main1.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main1.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "e" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "e" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) it "imports using from syntax" $ do (scopeGraph, (heap, res)) <- evaluate ["main2.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main2.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () -- TODO: Enable when we constrain edge paths with path predicates -- () <$ SpecHelpers.lookupDeclaration "baz" heap scopeGraph `shouldBe` Nothing @@ -47,7 +47,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main3.py", "c/__init__.py", "c/utils.py"] case ModuleTable.lookup "main3.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "utils" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "utils" scopeAndFrame heap scopeGraph `shouldBe` Just () -- (lookupDeclaration "utils" heap >>= deNamespace heap) `shouldBe` Just ("utils", ["to_s"]) other -> expectationFailure (show other) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 3e9208c3c1..9e409d9b9a 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -O0 #-} -{-# LANGUAGE ImplicitParams, TupleSections #-} +{-# LANGUAGE ImplicitParams #-} module Analysis.Ruby.Spec (spec) where import Control.Abstract (Declaration (..), ScopeError (..)) @@ -51,7 +51,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["modules.rb"] case ModuleTable.lookup "modules.rb" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) it "handles break correctly" $ do @@ -95,7 +95,7 @@ spec = parallel $ do case ModuleTable.lookup "puts.rb" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Unit - const () <$> SpecHelpers.lookupDeclaration "puts" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "puts" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) where diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index a0e9db641b..d462b9d71f 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -36,8 +36,8 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main.ts", "foo.ts", "foo/b.ts"] case ModuleTable.lookup "main.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - const () <$> SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - const () <$> SpecHelpers.lookupDeclaration "quz" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "quz" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) @@ -59,7 +59,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["a.ts"] case ModuleTable.lookup "a.ts" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - const () <$> SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Just () value `shouldBe` Unit other -> expectationFailure (show other) @@ -67,7 +67,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main4.ts", "foo.ts"] case ModuleTable.lookup "main4.ts" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - const () <$> SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () value `shouldBe` String (pack "\"this is the foo function\"") other -> expectationFailure (show other) @@ -88,7 +88,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["early-return.ts"] case ModuleTable.lookup "early-return.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> - const () <$> SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () other -> expectationFailure (show other) it "evaluates sequence expressions" $ do @@ -117,7 +117,7 @@ spec = parallel $ do case ModuleTable.lookup "await.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do -- Test that f2 is in the scopegraph and heap. - const () <$> SpecHelpers.lookupDeclaration "f2" scopeAndFrame heap scopeGraph `shouldBe` Just () + () <$ SpecHelpers.lookupDeclaration "f2" scopeAndFrame heap scopeGraph `shouldBe` Just () -- Test we can't reference y from outside the function SpecHelpers.lookupDeclaration "y" scopeAndFrame heap scopeGraph `shouldBe` Nothing other -> expectationFailure (show other) diff --git a/test/Data/Scientific/Spec.hs b/test/Data/Scientific/Spec.hs index 894173964f..fed5632046 100644 --- a/test/Data/Scientific/Spec.hs +++ b/test/Data/Scientific/Spec.hs @@ -2,12 +2,13 @@ module Data.Scientific.Spec (spec) where import Data.Scientific.Exts import Data.Either +import Data.Foldable (for_) import SpecHelpers spec :: Spec spec = describe "Scientific parsing" $ do - let go cases = forM_ cases $ \(s, v) -> parseScientific s `shouldBe` Right v + let go cases = for_ cases $ \(s, v) -> parseScientific s `shouldBe` Right v -- TODO: hexadecimal floats, someday (0x1.999999999999ap-4) diff --git a/test/Examples.hs b/test/Examples.hs index 363f73000a..d31136f552 100644 --- a/test/Examples.hs +++ b/test/Examples.hs @@ -55,7 +55,7 @@ main = withOptions opts $ \ config logger statter -> hspec . parallel $ do -- Other exceptions are true failures _ -> expectationFailure (show (displayException e)) _ -> if file `elem` knownFailures - then pendingWith $ "Known parse failures " <> show (const "Assignment: OK" <$> res) + then pendingWith $ "Known parse failures " <> show ("Assignment: OK" <$ res) else res `shouldSatisfy` isRight setupExampleRepos = readProcess "script/clone-example-repos" mempty mempty >>= print diff --git a/test/Numeric/Spec.hs b/test/Numeric/Spec.hs index 383b59fe3e..e4db469005 100644 --- a/test/Numeric/Spec.hs +++ b/test/Numeric/Spec.hs @@ -4,12 +4,13 @@ module Numeric.Spec import SpecHelpers import Data.Either +import Data.Foldable (for_) import Numeric.Exts spec :: Spec spec = describe "Integer parsing" $ do - let go cases = forM_ cases $ \(s, v) -> parseInteger s `shouldBe` Right v + let go cases = for_ cases $ \(s, v) -> parseInteger s `shouldBe` Right v it "should handle Python integers" $ go [ ("-1", (negate 1)) diff --git a/test/Rewriting/JSON/Spec.hs b/test/Rewriting/JSON/Spec.hs index fef994ba52..d910cd7c15 100644 --- a/test/Rewriting/JSON/Spec.hs +++ b/test/Rewriting/JSON/Spec.hs @@ -28,7 +28,7 @@ onTrees = do guard (null els) k <- create $ Literal.TextElement "\"hi\"" v <- create $ Literal.TextElement "\"bye\"" - pair <- create $ (Literal.KeyValue k v) + pair <- create $ Literal.KeyValue k v create (Literal.Hash (pair : els)) -- Matches only "hi" string literals. From ade8e8b26501b45f4c256421ad697a3691c3cc31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 16 Jun 2019 17:14:03 +0200 Subject: [PATCH 2/2] Use isJust where applicable --- test/Analysis/Go/Spec.hs | 12 ++++++------ test/Analysis/PHP/Spec.hs | 12 ++++++------ test/Analysis/Python/Spec.hs | 18 +++++++++--------- test/Analysis/Ruby/Spec.hs | 12 ++++++------ test/Analysis/TypeScript/Spec.hs | 24 ++++++++++++------------ 5 files changed, 39 insertions(+), 39 deletions(-) diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 3cfe5e2b68..e1cc2f357a 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -14,19 +14,19 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"] case ModuleTable.lookup "main.go" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust SpecHelpers.lookupMembers "foo" Import scopeAndFrame heap scopeGraph `shouldBe` Just ["New"] - () <$ SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "Rab" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "Rab" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "imports with aliases (and side effects only)" $ do (scopeGraph, (heap, res)) <- evaluate ["main1.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"] case ModuleTable.lookup "main1.go" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "f" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "f" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "main" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust -- (lookupDeclaration "f" heap >>= deNamespace heap) `shouldBe` Just ("f", ["New"]) other -> expectationFailure (show other) diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 4ee06932e2..6f4f5099d5 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -16,8 +16,8 @@ spec = parallel $ do case ModuleTable.lookup "main.php" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Unit - () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) xit "evaluates include_once and require_once" $ do @@ -25,16 +25,16 @@ spec = parallel $ do case ModuleTable.lookup "main_once.php" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Unit - () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) xit "evaluates namespaces" $ do (scopeGraph, (heap, res)) <- evaluate ["namespaces.php"] case ModuleTable.lookup "namespaces.php" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "NS1" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "NS1" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust undefined -- (derefQName heap ("NS1" :| []) env >>= deNamespace heap) `shouldBe` Just ("NS1", ["Sub1", "b", "c"]) diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index bc0ea22817..6073fec500 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -16,8 +16,8 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "a" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "a" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust fromJust (SpecHelpers.lookupMembers "a" Import scopeAndFrame heap scopeGraph) `shouldContain` [ "foo" ] fromJust (SpecHelpers.lookupMembers "b" Import scopeAndFrame heap scopeGraph) `shouldContain` ["c"] @@ -28,16 +28,16 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main1.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main1.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "e" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "e" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "imports using from syntax" $ do (scopeGraph, (heap, res)) <- evaluate ["main2.py", "a.py", "b/__init__.py", "b/c.py"] case ModuleTable.lookup "main2.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust -- TODO: Enable when we constrain edge paths with path predicates -- () <$ SpecHelpers.lookupDeclaration "baz" heap scopeGraph `shouldBe` Nothing @@ -47,7 +47,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main3.py", "c/__init__.py", "c/utils.py"] case ModuleTable.lookup "main3.py" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "utils" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "utils" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust -- (lookupDeclaration "utils" heap >>= deNamespace heap) `shouldBe` Just ("utils", ["to_s"]) other -> expectationFailure (show other) @@ -55,8 +55,8 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["subclass.py"] case ModuleTable.lookup "subclass.py" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - () <$ SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust SpecHelpers.lookupMembers "Bar" Superclass scopeAndFrame heap scopeGraph `shouldBe` Just [ "dang" ] value `shouldBe` String "\"bar\"" other -> expectationFailure (show other) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 9e409d9b9a..dd04ca4f51 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -22,7 +22,7 @@ spec = parallel $ do case ModuleTable.lookup "main.rb" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Integer (Number.Integer 1) - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "evaluates load" $ do @@ -30,7 +30,7 @@ spec = parallel $ do case ModuleTable.lookup "load.rb" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Value.Integer (Number.Integer 1) - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "evaluates load with wrapper" $ do @@ -42,8 +42,8 @@ spec = parallel $ do case ModuleTable.lookup "subclass.rb" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` String "\"\"" - () <$ SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "Foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust SpecHelpers.lookupMembers "Bar" Superclass scopeAndFrame heap scopeGraph `shouldBe` Just ["baz", "foo", "inspect"] other -> expectationFailure (show other) @@ -51,7 +51,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["modules.rb"] case ModuleTable.lookup "modules.rb" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "Bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "handles break correctly" $ do @@ -95,7 +95,7 @@ spec = parallel $ do case ModuleTable.lookup "puts.rb" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do value `shouldBe` Unit - () <$ SpecHelpers.lookupDeclaration "puts" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "puts" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) where diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index d462b9d71f..113c5513e4 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -29,15 +29,15 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main6.ts", "baz.ts", "foo.ts"] case ModuleTable.lookup "main6.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "imports with aliased symbols" $ do (scopeGraph, (heap, res)) <- evaluate ["main.ts", "foo.ts", "foo/b.ts"] case ModuleTable.lookup "main.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "quz" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "bar" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "quz" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) @@ -45,21 +45,21 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main1.ts", "foo.ts", "a.ts"] case ModuleTable.lookup "main1.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do - () <$ SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldBe` Just () - () <$ SpecHelpers.lookupDeclaration "z" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "b" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust + SpecHelpers.lookupDeclaration "z" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust lookupMembers "b" Import scopeAndFrame heap scopeGraph `shouldBe` Just [ "baz", "foo" ] lookupMembers "z" Import scopeAndFrame heap scopeGraph `shouldBe` Just [ "baz", "foo" ] - () <$ SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Nothing - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Nothing + SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Nothing + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Nothing other -> expectationFailure (show other) it "stores function declaration in scope graph" $ do (scopeGraph, (heap, res)) <- evaluate ["a.ts"] case ModuleTable.lookup "a.ts" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - () <$ SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust value `shouldBe` Unit other -> expectationFailure (show other) @@ -67,7 +67,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main4.ts", "foo.ts"] case ModuleTable.lookup "main4.ts" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust value `shouldBe` String (pack "\"this is the foo function\"") other -> expectationFailure (show other) @@ -75,7 +75,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["main3.ts", "a.ts"] case ModuleTable.lookup "main3.ts" <$> res of Right (Just (Module _ (scopeAndFrame, value))) -> do - () <$ SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Nothing + SpecHelpers.lookupDeclaration "baz" scopeAndFrame heap scopeGraph `shouldBe` Nothing value `shouldBe` Unit Heap.heapSize heap `shouldBe` 4 other -> expectationFailure (show other) @@ -88,7 +88,7 @@ spec = parallel $ do (scopeGraph, (heap, res)) <- evaluate ["early-return.ts"] case ModuleTable.lookup "early-return.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> - () <$ SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "foo" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust other -> expectationFailure (show other) it "evaluates sequence expressions" $ do @@ -117,7 +117,7 @@ spec = parallel $ do case ModuleTable.lookup "await.ts" <$> res of Right (Just (Module _ (scopeAndFrame, _))) -> do -- Test that f2 is in the scopegraph and heap. - () <$ SpecHelpers.lookupDeclaration "f2" scopeAndFrame heap scopeGraph `shouldBe` Just () + SpecHelpers.lookupDeclaration "f2" scopeAndFrame heap scopeGraph `shouldSatisfy` isJust -- Test we can't reference y from outside the function SpecHelpers.lookupDeclaration "y" scopeAndFrame heap scopeGraph `shouldBe` Nothing other -> expectationFailure (show other)