diff --git a/semantic-python/app/Main.hs b/semantic-python/app/Main.hs index 69e68454d..28a4a26ee 100644 --- a/semantic-python/app/Main.hs +++ b/semantic-python/app/Main.hs @@ -41,12 +41,12 @@ The graph should be -} -runScopeGraph :: ScopeGraph.ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> ScopeGraph.ScopeGraph ScopeGraph.Info -runScopeGraph p _src item = fst . run . runSketch (Just p) $ ScopeGraph.scopeGraph item +runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> ScopeGraph.ScopeGraph ScopeGraph.Info +runScopeGraph p _src item = run . runSketch @ScopeGraph.Info (Just p) $ scopeGraph item -sampleGraphThing :: (Has (Sketch ScopeGraph.Info) sig m) => m () +sampleGraphThing :: (Has (Sketch ScopeGraph.Info) sig m) => m (ScopeGraph.ScopeGraph ScopeGraph.Info) sampleGraphThing = do - declare @ScopeGraph.Info "hello" DeclProperties + void $ declare @ScopeGraph.Info "hello" DeclProperties declare @ScopeGraph.Info "goodbye" DeclProperties @@ -59,7 +59,7 @@ main = do file <- ByteString.readFile path tree <- TS.parseByteString @Py.Module @Loc TSP.tree_sitter_python file pyModule <- either die pure tree - let expecto = fst . run $ runSketch Nothing sampleGraphThing + let expecto = run $ runSketch @ScopeGraph.Info Nothing sampleGraphThing let result = runScopeGraph (Path.absRel path) (Source.fromUTF8 file) pyModule print result assertEqual expecto result diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 0a07f54d2..26e37b2f5 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -16,19 +17,29 @@ module Language.Python -- import Control.Carrier.Reader -- import Control.Monad.IO.Class +import AST.Element import Control.Effect.Sketch import Convert.ToScopeGraph -import Convert.ToScopeGraph (ToScopeGraph (..), onChildren) import Data.Foldable import qualified Data.List.NonEmpty as NonEmpty import qualified Data.ScopeGraph as ScopeGraph -import GHC.Generics +import Data.Text (Text) import qualified Language.Python.Tags as PyTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Python (tree_sitter_python) import qualified TreeSitter.Python.AST as Py import qualified TreeSitter.Unmarshal as TS +-- | Useful pattern synonym for extracting a single identifier from +-- a Python ExpressionList. Easier than pattern-matching every time. +-- TODO: when this is finished, we won't need this pattern, as we'll +-- handle ExpressionLists the smart way every time. +pattern SingleIdentifier :: Text -> Py.ExpressionList a +pattern SingleIdentifier name <- Py.ExpressionList + { Py.extraChildren = + Py.Expression (Prj (Py.PrimaryExpression (Prj Py.Identifier { text = name }))) NonEmpty.:| [] + } + todo :: Show a => a -> b todo s = error ("TODO: " <> show s) @@ -49,6 +60,10 @@ instance ToScopeGraph Py.BreakStatement where scopeGraph = todo instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren +instance ToScopeGraph Py.Assignment where + scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = declare @ScopeGraph.Info t DeclProperties + scopeGraph x = todo x + instance ToScopeGraph Py.Await where scopeGraph (Py.Await _ a) = scopeGraph a @@ -58,10 +73,15 @@ instance ToScopeGraph Py.BooleanOperator where instance ToScopeGraph Py.BinaryOperator where scopeGraph (Py.BinaryOperator _ _ left right) = mappend <$> scopeGraph left <*> scopeGraph right +instance ToScopeGraph Py.AugmentedAssignment where + scopeGraph Py.AugmentedAssignment{ right } = scopeGraph right + instance ToScopeGraph Py.Attribute where scopeGraph = todo instance ToScopeGraph Py.Block where scopeGraph = onChildren +instance ToScopeGraph Py.BreakStatement where scopeGraph = const (pure mempty) + instance ToScopeGraph Py.Call where scopeGraph = todo instance ToScopeGraph Py.ClassDefinition where scopeGraph = todo @@ -121,8 +141,8 @@ instance ToScopeGraph Py.FutureImportStatement where scopeGraph = todo instance ToScopeGraph Py.GeneratorExpression where scopeGraph = todo instance ToScopeGraph Py.Identifier where - scopeGraph (Py.Identifier _ t) = do - declare @ScopeGraph.Info t DeclProperties + scopeGraph (Py.Identifier _ _t) = pure mempty -- TODO + instance ToScopeGraph Py.IfStatement where scopeGraph (Py.IfStatement _ alternative body condition) = do diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index f3ca48783..e68fb641f 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -5,6 +5,7 @@ module Language.Python.Core ( toplevelCompile , Bindings +, pattern SingleIdentifier ) where import Prelude hiding (fail) diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index 4c1b945be..e7bc54daa 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -22,7 +22,6 @@ import Control.Carrier.Fresh.Strict import Control.Carrier.State.Strict import Control.Effect.Sketch import Control.Monad.IO.Class -import Data.Bifunctor import Data.Maybe import Data.Monoid import Data.Monoid.Generic