Merge branch 'master' into charliesome/module-result

semantic.cabal

@@ -83,7 +83,6 @@ library
                      , Data.Language
                      , Data.Map.Monoidal
                      , Data.Mergeable
-                     , Data.Options
                      , Data.Patch
                      , Data.Project
                      , Data.Range
@@ -249,9 +248,9 @@ library
                      , StrictData
                      , TypeApplications
   if flag(release)
-    ghc-options:       -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j
+    ghc-options:       -Wall -Werror -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j
   else
-    ghc-options:       -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j
+    ghc-options:       -Wall -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j
   ghc-prof-options:    -fprof-auto
 
 executable semantic

src/Analysis/Abstract/Caching.hs

@@ -125,8 +125,8 @@ scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address (Cell
 scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value)
 
 
-caching :: (Alternative f, Effects effects) => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, f a)
+caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, [a])
 caching
   = runState lowerBound
   . runReader lowerBound
-  . runNonDetA
+  . runNonDet

src/Analysis/Abstract/Graph.hs

@@ -47,12 +47,12 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexName))
 -- | Add vertices to the graph for evaluated identifiers.
 graphingTerms :: ( Element Syntax.Identifier syntax
                  , Member (Reader ModuleInfo) effects
-                 , Member (Env (Hole (Located address))) effects
+                 , Member (Env (Hole context (Located address))) effects
                  , Member (State (Graph Vertex)) effects
                  , Base term ~ TermF (Sum syntax) ann
                  )
-              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
-              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
+              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
+              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
 graphingTerms recur term@(In _ syntax) = do
   case project syntax of
     Just (Syntax.Identifier name) -> do
@@ -128,11 +128,11 @@ moduleInclusion v = do
   appendGraph (vertex (moduleVertex m) `connect` vertex v)
 
 -- | Add an edge from the passed variable name to the module it originated within.
-variableDefinition :: ( Member (Env (Hole (Located address))) effects
+variableDefinition :: ( Member (Env (Hole context (Located address))) effects
                       , Member (State (Graph Vertex)) effects
                       )
                    => Name
-                   -> TermEvaluator term (Hole (Located address)) value effects ()
+                   -> TermEvaluator term (Hole context (Located address)) value effects ()
 variableDefinition name = do
   graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
   appendGraph (vertex (Variable (formatName name)) `connect` graph)

src/Control/Abstract/Addressable.hs

@@ -54,15 +54,15 @@ instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Membe
 instance Derefable address effects => Derefable (Located address) effects where
   derefCell (Located loc _ _) = relocate . derefCell loc
 
-instance Addressable address effects => Addressable (Hole address) effects where
-  type Cell (Hole address) = Cell address
+instance (Addressable address effects, Ord context, Show context) => Addressable (Hole context address) effects where
+  type Cell (Hole context address) = Cell address
 
-instance Allocatable address effects => Allocatable (Hole address) effects where
+instance (Allocatable address effects, Ord context, Show context) => Allocatable (Hole context address) effects where
   allocCell name = relocate (Total <$> allocCell name)
 
-instance Derefable address effects => Derefable (Hole address) effects where
+instance (Derefable address effects, Ord context, Show context) => Derefable (Hole context address) effects where
   derefCell (Total loc) = relocate . derefCell loc
-  derefCell Partial     = const (pure Nothing)
+  derefCell (Partial _) = const (pure Nothing)
 
 relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
 relocate = raiseEff . lowerEff

src/Control/Abstract/Hole.hs

@@ -1,15 +1,21 @@
-module Control.Abstract.Hole where
+module Control.Abstract.Hole
+  ( AbstractHole (..)
+  , Hole (..)
+  , toMaybe
+  ) where
+
+import Prologue
 
 class AbstractHole a where
   hole :: a
 
 
-data Hole a = Partial | Total a
+data Hole context a = Partial context | Total a
   deriving (Foldable, Functor, Eq, Ord, Show, Traversable)
 
-instance AbstractHole (Hole a) where
-  hole = Partial
+instance Lower context => AbstractHole (Hole context a) where
+  hole = Partial lowerBound
 
-toMaybe :: Hole a -> Maybe a
-toMaybe Partial = Nothing
-toMaybe (Total a) = Just a
+toMaybe :: Hole context a -> Maybe a
+toMaybe (Partial _) = Nothing
+toMaybe (Total a)   = Just a

src/Control/Abstract/Primitive.hs

@@ -1,4 +1,11 @@
-module Control.Abstract.Primitive where
+module Control.Abstract.Primitive
+  ( define
+  , defineClass
+  , defineNamespace
+  , builtInPrint
+  , builtInExport
+  , lambda
+  ) where
 
 import Control.Abstract.Context
 import Control.Abstract.Environment

src/Control/Abstract/Value.hs

@@ -124,6 +124,9 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a
 
+  -- | Compute the disjunction (boolean or) of two computed values. This should have short-circuiting semantics where applicable.
+  disjunction :: Evaluator address value effects value -> Evaluator address value effects value -> Evaluator address value effects value
+
   -- | @index x i@ computes @x[i]@, with zero-indexing.
   index :: value -> value -> Evaluator address value effects address
 

src/Data/AST.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE DataKinds #-}
-module Data.AST where
+module Data.AST
+  ( Node (..)
+  , AST
+  , Location
+  , nodeLocation
+  ) where
 
 import Data.Range
 import Data.Record

src/Data/Abstract/Address.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
-module Data.Abstract.Address where
+module Data.Abstract.Address
+  ( Precise (..)
+  , Located (..)
+  , Latest (..)
+  , All (..)
+  , Monovariant (..)
+  ) where
 
 import Data.Abstract.Module (ModuleInfo)
 import Data.Abstract.Name

src/Data/Abstract/Cache.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
-module Data.Abstract.Cache where
+module Data.Abstract.Cache
+  ( Cache
+  , Cached (..)
+  , Cacheable
+  , cacheLookup
+  , cacheSet
+  , cacheInsert
+  , cacheKeys
+  ) where
 
 import Data.Abstract.Configuration
 import Data.Abstract.Heap

src/Data/Abstract/Configuration.hs

@@ -1,4 +1,4 @@
-module Data.Abstract.Configuration where
+module Data.Abstract.Configuration ( Configuration (..) ) where
 
 import Data.Abstract.Environment
 import Data.Abstract.Heap

src/Data/Abstract/Declarations.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
-module Data.Abstract.Declarations  where
+module Data.Abstract.Declarations
+  ( Declarations (..)
+  , Declarations1 (..)
+  ) where
 
 import Data.Abstract.Name
 import Data.Sum

src/Data/Abstract/FreeVariables.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-}
-module Data.Abstract.FreeVariables where
+module Data.Abstract.FreeVariables
+  ( FreeVariables (..)
+  , FreeVariables1 (..)
+  ) where
 
 import Data.Abstract.Name
 import           Data.Sum

src/Data/Abstract/Heap.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Data.Abstract.Heap where
+module Data.Abstract.Heap
+  ( Heap
+  , heapLookup
+  , heapLookupAll
+  , heapInsert
+  , heapInit
+  , heapSize
+  , heapRestrict
+  ) where
 
 import Data.Abstract.Live
 import qualified Data.Map.Monoidal as Monoidal

src/Data/Abstract/Live.hs

@@ -1,5 +1,15 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-module Data.Abstract.Live where
+module Data.Abstract.Live
+  ( Live (..)
+  , fromAddresses
+  , liveSingleton
+  , liveInsert
+  , liveDelete
+  , liveDifference
+  , liveMember
+  , liveSplit
+  , liveMap
+  ) where
 
 import Data.Set as Set
 import Prologue

src/Data/Abstract/Package.hs

@@ -1,4 +1,9 @@
-module Data.Abstract.Package where
+module Data.Abstract.Package
+  ( Package (..)
+  , PackageInfo (..)
+  , PackageName
+  , Data.Abstract.Package.fromModules
+  ) where
 
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable

src/Data/Abstract/Path.hs

@@ -1,4 +1,8 @@
-module Data.Abstract.Path where
+module Data.Abstract.Path
+  ( dropRelativePrefix
+  , joinPaths
+  , stripQuotes
+  ) where
 
 import Prologue
 import qualified Data.Text as T

src/Data/Abstract/Ref.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE GADTs #-}
-module Data.Abstract.Ref where
+module Data.Abstract.Ref
+  ( ValueRef (..)
+  , Ref (..)
+  ) where
 
 import Data.Abstract.Name
 

src/Data/Abstract/Value/Abstract.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, UndecidableInstances #-}
-module Data.Abstract.Value.Abstract where
+module Data.Abstract.Value.Abstract ( Abstract (..) ) where
 
 import Control.Abstract
 import Data.Abstract.Environment as Env
@@ -69,6 +69,7 @@ instance ( Member (Allocator address Abstract) effects
   index _ _ = box Abstract
 
   ifthenelse _ if' else' = if' <|> else'
+  disjunction = (<|>)
 
   liftNumeric _ _ = pure Abstract
   liftNumeric2 _ _ _ = pure Abstract

src/Data/Abstract/Value/Concrete.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances, LambdaCase #-}
-module Data.Abstract.Value.Concrete where
+module Data.Abstract.Value.Concrete
+  ( Value (..)
+  , ValueError (..)
+  , ClosureBody (..)
+  , materializeEnvironment
+  , runValueError
+  , runValueErrorWith
+  , throwValueError
+  ) where
 
 import Control.Abstract
 import Data.Abstract.Environment (Environment, Bindings)
@@ -162,6 +170,11 @@ instance ( Coercible body (Eff effects)
     bool <- case cond of { Boolean b -> pure b ; _ -> throwValueError (BoolError cond) }
     if bool then if' else else'
 
+  disjunction a b = do
+    a' <- a
+    ifthenelse a' (pure a') b
+
+
   index = go where
     tryIdx list ii
       | ii > genericLength list = box =<< throwValueError (BoundsError list ii)

src/Data/Abstract/Value/Type.hs

@@ -295,6 +295,9 @@ instance ( Member (Allocator address Type) effects
     box (Var field)
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
+  disjunction a b = do
+    a' <- a
+    unify a' Bool *> (pure a' <|> b)
 
   liftNumeric _ = unify (Int :+ Float :+ Rational)
   liftNumeric2 _ left right = case (left, right) of

src/Data/Graph/Vertex.hs

@@ -6,14 +6,14 @@ module Data.Graph.Vertex
   , vertexToType
   ) where
 
-import Prologue hiding (packageName)
+import Prologue
 
 import           Data.Aeson
 import qualified Data.Text as T
 
 import Data.Abstract.Module (ModuleInfo (..))
 import Data.Abstract.Name
-import Data.Abstract.Package (PackageInfo (..))
+import Data.Abstract.Package hiding (Package (Package))
 
 -- | A vertex of some specific type.
 data Vertex
@@ -23,7 +23,7 @@ data Vertex
   deriving (Eq, Ord, Show, Generic, Hashable)
 
 packageVertex :: PackageInfo -> Vertex
-packageVertex = Package . formatName . packageName
+packageVertex = Package . formatName . Data.Abstract.Package.packageName
 
 moduleVertex :: ModuleInfo -> Vertex
 moduleVertex = Module . T.pack . modulePath

src/Data/Language.hs

@@ -1,5 +1,12 @@
 {-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-}
-module Data.Language where
+module Data.Language
+  ( Language (..)
+  , ensureLanguage
+  , extensionsForLanguage
+  , knownLanguage
+  , languageForFilePath
+  , languageForType
+  ) where
 
 import           Data.Aeson
 import           Data.Char (toUpper)

src/Data/Mergeable.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DefaultSignatures, TypeOperators, UndecidableInstances #-}
-module Data.Mergeable where
+module Data.Mergeable ( Mergeable (..) ) where
 
 import Control.Applicative
 import Data.Functor.Identity

src/Data/Options.hs

@@ -1 +0,0 @@
-module Data.Options where

src/Data/Record.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE ConstraintKinds, DataKinds, GADTs, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}
-module Data.Record where
+module Data.Record
+  ( Record (..)
+  , HasField (..)
+  , rhead
+  , rtail
+  ) where
 
 import Data.Aeson
 import Data.JSON.Fields

src/Data/SplitDiff.hs

@@ -1,4 +1,7 @@
-module Data.SplitDiff where
+module Data.SplitDiff
+  ( SplitPatch (..)
+  , getRange
+  ) where
 
 import Control.Monad.Free
 import Data.Range
@@ -20,6 +23,3 @@ getRange diff = getField $ case diff of
 
 -- | A diff with only one side’s annotations.
 type SplitDiff syntax ann = Free (TermF syntax ann) (SplitPatch (Term syntax ann))
-
-unSplit :: Functor syntax => SplitDiff syntax ann -> Term syntax ann
-unSplit = iter Term . fmap splitTerm

src/Data/Syntax.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes, DeriveAnyClass, GADTs, TypeOperators, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, KindSignatures, RankNTypes, ConstraintKinds, GeneralizedNewtypeDeriving, DerivingStrategies #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack
+{-# OPTIONS_GHC -Wno-missing-export-lists -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack
 module Data.Syntax where
 
 import Data.Abstract.Evaluatable

src/Data/Syntax/Comment.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Comment where
 
 import Data.Abstract.Evaluatable

src/Data/Syntax/Declaration.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Declaration where
 
 import qualified Data.Abstract.Environment as Env

src/Data/Syntax/Directive.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Directive where
 
 import           Data.Abstract.Evaluatable

src/Data/Syntax/Expression.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Expression where
 
 import Data.Abstract.Evaluatable hiding (Member)
@@ -223,10 +224,7 @@ instance Ord1 Or where liftCompare = genericLiftCompare
 instance Show1 Or where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Or where
-  eval t = rvalBox =<< go (fmap subtermValue t) where
-    go (Or a b) = do
-      cond <- a
-      ifthenelse cond (pure cond) b
+  eval (Or a b) = disjunction (subtermValue a) (subtermValue b) >>= rvalBox
 
 data And a = And { lhs :: a, rhs :: a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

src/Data/Syntax/Literal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, ViewPatterns, ScopedTypeVariables, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Literal where
 
 import           Data.Abstract.Evaluatable

src/Data/Syntax/Statement.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, UndecidableInstances, ViewPatterns, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Statement where
 
 import Data.Abstract.Evaluatable

src/Data/Syntax/Type.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Type where
 
 import Data.Abstract.Evaluatable

src/Diffing/Algorithm.hs

@@ -1,5 +1,18 @@
 {-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-}
-module Diffing.Algorithm where
+module Diffing.Algorithm
+  ( AlgorithmF (..)
+  , Algorithm
+  , Diffable (..)
+  , Equivalence (..)
+  , diff
+  , diffThese
+  , diffMaybe
+  , linearly
+  , byReplacing
+  , comparableTerms
+  , equivalentTerms
+  , algorithmForTerms
+  ) where
 
 import Control.Monad.Free.Freer
 import Data.Diff

src/Language/Go/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Grammar where
 
 import Language.Haskell.TH

src/Language/Go/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Syntax where
 
 import           Data.Abstract.Evaluatable

src/Language/Go/Type.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Type where
 
 import Prologue

src/Language/Haskell/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Haskell.Grammar where
 
 import Language.Haskell.TH

src/Language/Haskell/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Haskell.Syntax where
 
 import           Data.Abstract.Evaluatable

src/Language/JSON/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.JSON.Grammar where
 
 import Language.Haskell.TH

src/Language/Java/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Java.Grammar where
 
 import Language.Haskell.TH

src/Language/Java/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Java.Syntax where
 
 import Data.Abstract.Evaluatable

src/Language/Markdown/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Markdown.Syntax where
 
 import Prologue hiding (Text)

src/Language/PHP/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.PHP.Grammar where
 
 import Language.Haskell.TH

src/Language/PHP/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.PHP.Syntax where
 
 import           Control.Abstract.Modules

src/Language/Python/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Python.Grammar where
 
 import Language.Haskell.TH

src/Language/Python/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Python.Syntax where
 
 import           Data.Abstract.Environment as Env

src/Language/Ruby/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Ruby.Grammar where
 
 import Language.Haskell.TH

src/Language/Ruby/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Ruby.Syntax where
 
 import           Control.Monad (unless)

src/Language/TypeScript/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.TypeScript.Grammar where
 
 import Language.Haskell.TH

src/Language/TypeScript/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.TypeScript.Syntax where
 
 import qualified Data.Abstract.Environment as Env

src/Semantic/AST.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Semantic.AST where
+module Semantic.AST
+  ( SomeAST (..)
+  , withSomeAST
+  , astParseBlob
+  , ASTFormat (..)
+  , runASTParse
+  ) where
 
 import Data.AST
 import Data.Blob

src/Semantic/Config.hs

@@ -1,6 +1,17 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Semantic.Config where
+module Semantic.Config
+  ( Config (..)
+  , defaultConfig
+  , Options (..)
+  , defaultOptions
+  , debugOptions
+  , lookupStatsAddr
+  , withHaystackFromConfig
+  , withLoggerFromConfig
+  , withStatterFromConfig
+  , withTelemetry
+  ) where
 
 import           Network.BSD
 import           Network.HTTP.Client.TLS

src/Semantic/Diff.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables #-}
-module Semantic.Diff where
+module Semantic.Diff
+  ( runDiff
+  , runRubyDiff
+  , runTypeScriptDiff
+  , runJSONDiff
+  , diffBlobTOCPairs
+  ) where
 
 import Analysis.ConstructorName (ConstructorName)
 import Analysis.Declaration (HasDeclaration, declarationAlgebra)

src/Semantic/Env.hs

@@ -1,4 +1,7 @@
-module Semantic.Env where
+module Semantic.Env
+  ( envLookupInt
+  , envLookupString
+  ) where
 
 import Control.Monad.IO.Class
 import Prologue

src/Semantic/Graph.hs

@@ -27,7 +27,6 @@ import           Analysis.Abstract.Caching
 import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
 import           Control.Abstract
-import           Control.Monad.Effect (reinterpret)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
@@ -35,7 +34,7 @@ import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Package as Package
 import           Data.Abstract.Value.Abstract
 import           Data.Abstract.Value.Type
-import           Data.Abstract.Value.Concrete (Value, ValueError (..), runValueErrorWith)
+import           Data.Abstract.Value.Concrete (Value,ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
 import           Data.Record
@@ -90,9 +89,12 @@ runCallGraph :: ( HasField ann Span
 runCallGraph lang includePackages modules package = do
   let analyzeTerm = withTermSpans . graphingTerms . cachingTerms
       analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
-      extractGraph (_, (_, (graph, _))) = simplify graph
+      extractGraph (graph, _) = simplify graph
       runGraphAnalysis
-        = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Abstract))
+        = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract
+        . graphing
+        . caching
+        . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract))
         . runFresh 0
         . resumingLoadError
         . resumingUnspecialized
@@ -100,13 +102,10 @@ runCallGraph lang includePackages modules package = do
         . resumingEvalError
         . resumingResolutionError
         . resumingAddressError
-        . runTermEvaluator @_ @(Hole (Located Monovariant)) @Abstract
-        . graphing
-        . caching @[]
         . runReader (packageInfo package)
         . runReader (lowerBound @Span)
         . providingLiveSet
-        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Located Monovariant)))))))
+        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Maybe Name) (Located Monovariant)))))))
         . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
   extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules))
 
@@ -130,7 +129,7 @@ runImportGraph lang (package :: Package term)
   | [m :| []] <- toList (packageModules package) = vertex m <$ trace ("single module, skipping import graph computation for " <> modulePath (moduleInfo m))
   | otherwise =
   let analyzeModule = graphingModuleInfo
-      extractGraph (_, (_, (graph, _))) = do
+      extractGraph (_, (graph, _)) = do
         info <- graph
         maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package))
       runImportGraphAnalysis
@@ -146,7 +145,7 @@ runImportGraph lang (package :: Package term)
         . runState lowerBound
         . runReader lowerBound
         . runModules (ModuleTable.modulePaths (packageModules package))
-        . runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise) effs))
+        . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff term (Hole (Maybe Name) Precise) effs))
         . runReader (packageInfo package)
         . runReader lowerBound
   in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd)))
@@ -215,10 +214,10 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr
   NotFoundError nameToResolve _ _ -> pure  nameToResolve
   GoImportError pathToResolve     -> pure [pathToResolve])
 
-resumingLoadError :: (Member Trace effects, AbstractHole address, Effects effects) => Evaluator address value (Resumable (LoadError address) ': effects) a -> Evaluator address value effects a
+resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a
 resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole))
 
-resumingEvalError :: (Member Fresh effects, Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a
+resumingEvalError :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable EvalError ': effects) a -> m effects a
 resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of
   DefaultExportError{}  -> pure ()
   ExportError{}         -> pure ()
@@ -227,15 +226,15 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow
   RationalFormatError{} -> pure 0
   NoNameError           -> gensym)
 
-resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a
+resumingUnspecialized :: (AbstractHole value, Effectful (m value), Effects effects, Functor (m value effects), Member Trace effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
 resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole)
 
-resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a
-resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError: " <> prettyShow err) *> case err of
-  UnallocatedAddress _   -> pure lowerBound
-  UninitializedAddress _ -> pure hole)
+resumingAddressError :: (AbstractHole value, Applicative (m address value effects), Effectful (m address value), Effects effects, Lower (Cell address value), Member Trace effects, Show address) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a
+resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> prettyShow err) *> case err of
+  UnallocatedAddress   _ -> pure lowerBound
+  UninitializedAddress _ -> pure hole
 
-resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a
+resumingValueError :: (Applicative (m address (Value address body) effects), Effectful (m address (Value address body)), Effects effects, Member Trace effects, Show address) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a
 resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of
   CallError val     -> pure val
   StringError val   -> pure (pack (prettyShow val))
@@ -251,10 +250,8 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty
   KeyValueError{}   -> pure (hole, hole)
   ArithmeticError{} -> pure hole)
 
-resumingEnvironmentError :: (AbstractHole address, Effects effects) => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects ([Name], a)
-resumingEnvironmentError
-  = runState []
-  . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole)
+resumingEnvironmentError :: (Applicative (m (Hole (Maybe Name) address) value effects), Effectful (m (Hole (Maybe Name) address) value), Effects effects) => m (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> m (Hole (Maybe Name) address) value effects a
+resumingEnvironmentError = runResumableWith (\ (FreeVariable name) -> pure (Partial (Just name)))
 
 resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects))
                      , Effects effects

src/Semantic/Parse.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Semantic.Parse where
+module Semantic.Parse
+  ( runParse
+  , runRubyParse
+  , runTypeScriptParse
+  , runJSONParse
+  ) where
 
 import Analysis.ConstructorName (ConstructorName)
 import Analysis.Declaration (HasDeclaration, declarationAlgebra)

src/Semantic/Resolution.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE ConstraintKinds, GADTs, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
-module Semantic.Resolution where
+module Semantic.Resolution
+  ( Resolution (..)
+  , nodeJSResolutionMap
+  , resolutionMap
+  , runResolution
+  ) where
 
 import           Control.Monad.Effect
 import           Data.Aeson

src/Semantic/Telemetry/Haystack.hs

@@ -1,4 +1,10 @@
-module Semantic.Telemetry.Haystack where
+module Semantic.Telemetry.Haystack
+  ( HaystackClient (..)
+  , ErrorReport (..)
+  , ErrorLogger
+  , haystackClient
+  , reportError
+  ) where
 
 import           Control.Exception
 import           Crypto.Hash

src/Semantic/Telemetry/Log.hs

@@ -1,4 +1,12 @@
-module Semantic.Telemetry.Log where
+module Semantic.Telemetry.Log
+  ( Level (..)
+  , LogOptions (..)
+  , Message (..)
+  , LogFormatter
+  , logfmtFormatter
+  , terminalFormatter
+  , writeLogMessage
+  ) where
 
 import           Control.Monad.IO.Class
 import           Data.Error (withSGRCode)

src/Semantic/Util.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-export-lists #-}
 module Semantic.Util where
 
 import Prelude hiding (readFile)
@@ -83,7 +83,7 @@ checking
   . runFresh 0
   . runPrintingTrace
   . runTermEvaluator @_ @Monovariant @Type
-  . caching @[]
+  . caching
   . providingLiveSet
   . fmap reassociate
   . runLoadError
@@ -108,7 +108,7 @@ callGraphProject parser proxy lang opts paths = runTaskWithOptions opts $ do
   package <- parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
   modules <- topologicalSort <$> runImportGraph proxy package
   x <- runCallGraph proxy False modules package
-  pure (x, modules)
+  pure (x, (() <$) <$> modules)
 
 callGraphRubyProject = callGraphProject rubyParser (Proxy @'Language.Ruby) Language.Ruby debugOptions
 

src/Semantic/Version.hs

@@ -1,6 +1,9 @@
 {-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct.
 {-# LANGUAGE TemplateHaskell #-}
-module Semantic.Version where
+module Semantic.Version
+  ( buildSHA
+  , buildVersion
+  ) where
 
 import Data.Version (showVersion)
 import Development.GitRev