Skip to content
Permalink
Browse files

Fix some hlint warnings

  • Loading branch information...
jhrcek committed Jun 16, 2019
1 parent 02e56c9 commit 915937c4be388c6e0af6a7dfe0dc883380d1b010
@@ -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}
@@ -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
@@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, LambdaCase, RankNTypes, RecordWildCards #-}
{-# LANGUAGE FlexibleContexts, LambdaCase, RankNTypes, RecordWildCards #-}
module Analysis.Eval
( eval
, prog1
@@ -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
@@ -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
@@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main (main) where
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures #-}
module Data.Language
( Language (..)
, SLanguage (..)
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveAnyClass, KindSignatures, MultiWayIf #-}
{-# LANGUAGE DeriveAnyClass, MultiWayIf #-}

module Data.Project
( Project (..)
@@ -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)

@@ -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
@@ -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)

@@ -16,25 +16,25 @@ 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
(scopeGraph, (heap, res)) <- evaluate ["main_once.php", "foo.php", "bar.php"]
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"])
@@ -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)

@@ -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
@@ -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,15 +59,15 @@ 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)

it "imports functions" $ 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)
@@ -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)

@@ -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
@@ -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))
@@ -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.

0 comments on commit 915937c

Please sign in to comment.
You can’t perform that action at this time.