Merge remote-tracking branch 'origin/indexer-prototype' into deploy-to-moda

semantic.cabal

@@ -85,7 +85,6 @@ library
                      , Data.File
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic
-                     , Data.Git
                      , Proto3.Google.Timestamp
                      , Data.Graph
                      , Data.Graph.ControlFlowVertex
@@ -257,6 +256,7 @@ library
                      , http-types
                      , http-media
                      , kdt
+                     , lens
                      , machines
                      , mersenne-random-pure64
                      , mtl

src/Assigning/Assignment.hs

@@ -104,7 +104,7 @@ import Data.Error
 import Data.Range
 import qualified Data.Location as L
 import qualified Data.Source as Source (Source, slice, sourceBytes)
-import Data.Span
+import Data.Span hiding (HasSpan(..))
 import Data.Term
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8')

src/Assigning/Assignment/Deterministic.hs

@@ -16,7 +16,7 @@ import qualified Data.IntSet as IntSet
 import Data.Range
 import Data.Location
 import Data.Source as Source
-import Data.Span
+import Data.Span hiding (HasSpan (..))
 import qualified Data.Syntax as Syntax
 import Data.Term (Term, termIn, termAnnotation, termOut)
 import Data.Text.Encoding (decodeUtf8')

src/Data/Abstract/ScopeGraph.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections, LambdaCase #-}
+{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, LambdaCase, TupleSections #-}
 module Data.Abstract.ScopeGraph
   ( Slot(..)
   , Info(..)
@@ -39,20 +39,23 @@ module Data.Abstract.ScopeGraph
   , AccessControl(..)
   ) where
 
-import           Control.Abstract.Hole
-import           Data.Abstract.Name
+import Prelude hiding (lookup)
+import Prologue
+
+import           Control.Lens.Lens
 import           Data.Aeson
-import           Data.JSON.Fields (ToJSONFields(..))
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
-import           Data.Span
-import           Prelude hiding (lookup)
-import           Prologue
-import Data.Abstract.Module
-import qualified Proto3.Suite       as Proto
-import qualified Proto3.Wire.Encode as Encode
+import qualified Proto3.Suite as Proto
 import qualified Proto3.Wire.Decode as Decode
+import qualified Proto3.Wire.Encode as Encode
+
+import Control.Abstract.Hole
+import Data.Abstract.Module
+import Data.Abstract.Name
+import Data.JSON.Fields (ToJSONFields (..))
+import Data.Span
 
 -- A slot is a location in the heap where a value is stored.
 data Slot address = Slot { frameAddress :: address, position :: Position }
@@ -103,24 +106,31 @@ instance Lower Relation where
   lowerBound = Default
 
 data Info scopeAddress = Info
-  { infoDeclaration :: Declaration
-  , infoModule :: ModuleInfo
-  , infoRelation :: Relation
-  , infoAccessControl :: AccessControl
-  , infoSpan :: Span
-  , infoKind :: Kind
+  { infoDeclaration     :: Declaration
+  , infoModule          :: ModuleInfo
+  , infoRelation        :: Relation
+  , infoAccessControl   :: AccessControl
+  , infoSpan            :: Span
+  , infoKind            :: Kind
   , infoAssociatedScope :: Maybe scopeAddress
   } deriving (Eq, Show, Ord, Generic, NFData)
 
+instance HasSpan (Info scopeAddress) where
+  span = lens infoSpan (\i s -> i { infoSpan = s })
+  {-# INLINE span #-}
+
 instance Lower (Info scopeAddress) where
   lowerBound = Info lowerBound lowerBound lowerBound Public lowerBound lowerBound Nothing
 
 data ReferenceInfo = ReferenceInfo
-  { refSpan :: Span
-  , refKind :: Kind
+  { refSpan   :: Span
+  , refKind   :: Kind
   , refModule :: ModuleInfo
-  }
-  deriving (Eq, Show, Ord, Generic, NFData)
+  } deriving (Eq, Show, Ord, Generic, NFData)
+
+instance HasSpan ReferenceInfo where
+  span = lens refSpan (\r s -> r { refSpan = s })
+  {-# INLINE span #-}
 
 data Kind = TypeAlias | Class | Method | QualifiedAliasedImport | QualifiedExport | DefaultExport | Module | AbstractClass | Let | QualifiedImport | UnqualifiedImport | Assignment | RequiredParameter | PublicField | VariableDeclaration | Function | Parameter | Unknown | Identifier | TypeIdentifier | This | New | MemberAccess | Call
   deriving (Eq, Show, Ord, Generic, NFData)

src/Data/Git.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving #-}
-
--- | Core data types for Git repositories, suitable for
--- sharing between different storage backends.
-module Data.Git
-  ( OID (..)
-  , Ref (..)
-  , SHA (..)
-  , nullSHA
-  ) where
-
-import Prologue
-
-import Proto3.Suite
-
-newtype OID = OID Text
-  deriving stock (Eq, Show, Ord)
-  deriving newtype (MessageField, Primitive, NFData)
-
-newtype Ref = Ref Text
-  deriving stock (Eq, Show, Ord)
-  deriving newtype (MessageField, Primitive, NFData)
-
-newtype SHA = SHA Text
-  deriving stock (Eq, Show, Ord)
-  deriving newtype (MessageField, Primitive, NFData)
-
-nullSHA :: SHA
-nullSHA = SHA mempty

src/Data/Source.hs

@@ -27,17 +27,20 @@ module Data.Source
 ) where
 
 import Prologue
-import Data.Array
-import Data.Aeson (FromJSON (..), withText)
+
+import           Data.Aeson (FromJSON (..), withText)
+import           Data.Array
 import qualified Data.ByteString as B
-import Data.Char (ord)
-import Data.List (span)
-import Data.Range
-import Data.Span
-import Data.String (IsString(..))
+import           Data.Char (ord)
+import           Data.List (span)
+import           Data.String (IsString (..))
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import Proto3.Suite
+import           Proto3.Suite
+
+import Data.Range
+import Data.Span hiding (HasSpan (..))
+
 
 -- | The contents of a source file. This is represented as a UTF-8
 -- 'ByteString' under the hood. Construct these with 'fromUTF8'; obviously,

src/Data/Span.hs

@@ -5,34 +5,62 @@
 --   Mostly taken from purescript's SourcePos definition.
 module Data.Span
 ( Span(..)
+, HasSpan(..)
 , Pos(..)
+, line
+, column
 , spanFromSrcLoc
 , emptySpan
 ) where
 
-import Data.Aeson ((.=), (.:))
-import Proto3.Suite
-import Proto3.Wire.Decode as Decode
-import Proto3.Wire.Encode as Encode
-import qualified Data.Aeson as A
-import Data.JSON.Fields
-import GHC.Stack
+import Prelude hiding (span)
 import Prologue
 
+import           Control.Lens.Lens
+import           Data.Aeson ((.:), (.=))
+import qualified Data.Aeson as A
+import           GHC.Stack
+import           Proto3.Suite
+import           Proto3.Wire.Decode as Decode
+import           Proto3.Wire.Encode as Encode
+
+import Data.JSON.Fields
+
 -- | Source position information (1 indexed)
 data Pos = Pos
   { posLine   :: !Int
   , posColumn :: !Int
-  }
-  deriving (Eq, Ord, Generic, Hashable, NFData)
+  } deriving (Eq, Ord, Generic, Hashable, NFData)
+
+line, column :: Lens' Pos Int
+line   = lens posLine   (\p l -> p { posLine   = l })
+column = lens posColumn (\p l -> p { posColumn = l })
 
 -- | A Span of position information
 data Span = Span
   { spanStart :: Pos
   , spanEnd   :: Pos
-  }
-  deriving (Eq, Ord, Generic, Hashable, Named, NFData)
+  } deriving (Eq, Ord, Generic, Hashable, Named, NFData)
 
+-- | "Classy-fields" interface for data types that have spans.
+class HasSpan a where
+  span  :: Lens' a Span
+
+  start :: Lens' a Pos
+  start = span.start
+
+  end :: Lens' a Pos
+  end = span.end
+
+instance HasSpan Span where
+  span  = id
+  {-# INLINE span #-}
+
+  start = lens spanStart (\s t -> s { spanStart = t })
+  {-# INLINE start #-}
+
+  end = lens spanEnd   (\s t -> s { spanEnd   = t })
+  {-# INLINE end #-}
 
 -- Instances
 

src/Data/Tag.hs

@@ -4,12 +4,16 @@ module Data.Tag
   ( Tag (..)
   ) where
 
+import Prelude hiding (span)
 import Prologue
 
 import Data.Aeson
+import Control.Lens.Lens
 
 import Data.Span
 
+-- | These selectors aren't prefixed with @tag@ for reasons of JSON
+-- backwards compatibility.
 data Tag = Tag
   { name :: Text
   , kind :: Text
@@ -18,3 +22,7 @@ data Tag = Tag
   , line :: Maybe Text
   , docs :: Maybe Text
   } deriving (Eq, Show, Generic, ToJSON)
+
+instance HasSpan Tag where
+  span = lens Data.Tag.span (\t s -> t { Data.Tag.span = s })
+  {-# INLINE span #-}

src/Semantic/API/Symbols.hs

@@ -5,6 +5,8 @@ module Semantic.API.Symbols
   , parseSymbolsBuilder
   ) where
 
+import Prelude hiding (span)
+
 import           Control.Effect
 import           Control.Effect.Error
 import           Control.Exception