diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 2d79a8e79..1ca633456 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -23,7 +23,6 @@ common haskell build-depends: base ^>=4.12 , fused-effects ^>= 0.5 , semantic-core ^>= 0.0 - , pathtype ^>= 0.8.1 , text ^>= 1.2.3 , tree-sitter == 0.3.0.0 , tree-sitter-python == 0.4.0.0 @@ -65,6 +64,7 @@ test-suite test , containers ^>= 0.6 , directory ^>= 1.3.3 , exceptions ^>= 0.10.2 + , pathtype ^>= 0.8.1 , pretty-show ^>= 1.9.5 , process ^>= 1.6.5 , streaming ^>= 0.2.2 diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 56a5cbe5e..111dc2d4b 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -1,10 +1,11 @@ {-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveGeneric, DerivingStrategies, - DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, NamedFieldPuns, - OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TypeApplications, - TypeOperators, UndecidableInstances #-} + DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, + NamedFieldPuns, OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, + TypeApplications, TypeOperators, UndecidableInstances #-} module Language.Python.Core ( compile +, SourcePath ) where import Prelude hiding (fail) @@ -14,15 +15,19 @@ import Control.Effect.Reader import Control.Monad.Fail import Data.Core as Core import Data.Foldable +import qualified Data.Loc import Data.Name as Name +import Data.String (IsString) +import Data.Text (Text) import GHC.Generics import GHC.Records -import qualified Data.Loc import qualified TreeSitter.Python.AST as Py import TreeSitter.Span (Span) import qualified TreeSitter.Span as TreeSitter -import qualified System.Path as Path -import qualified Data.Text as Text + +newtype SourcePath = SourcePath { rawPath :: Text } + deriving stock (Eq, Show) + deriving newtype IsString -- We leave the representation of Core syntax abstract so that it's not -- possible for us to 'cheat' by pattern-matching on or eliminating a @@ -36,7 +41,7 @@ type CoreSyntax sig t = ( Member Core sig class Compile py where -- FIXME: we should really try not to fail compile :: ( CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m , MonadFail m ) @@ -47,7 +52,7 @@ class Compile py where compile = defaultCompile compileCC :: ( CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m , MonadFail m ) @@ -56,7 +61,7 @@ class Compile py where -> m (t Name) default compileCC :: ( CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m , MonadFail m ) => py -> m (t Name) -> m (t Name) @@ -64,11 +69,11 @@ class Compile py where locate :: ( HasField "ann" syntax Span , CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m ) => syntax -> t a -> m (t a) locate syn item = do - fp <- asks @Path.RelFile (Text.pack . Path.toString) + fp <- asks @SourcePath rawPath let locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d)) = Data.Loc.Loc fp (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d)) @@ -236,13 +241,13 @@ instance Compile (Py.Yield Span) class GCompileSum f where gcompileSum :: ( CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m , MonadFail m ) => f a -> m (t Name) gcompileCCSum :: ( CoreSyntax syn t - , Member (Reader Path.RelFile) sig + , Member (Reader SourcePath) sig , Carrier sig m , MonadFail m ) => f a -> m (t Name) -> m (t Name) diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index 1f599e02d..64a9a614e 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -24,6 +24,7 @@ import Data.Loc import Data.Maybe import Data.Name import Data.Term +import Data.String (fromString) import GHC.Stack import qualified Language.Python.Core as Py import Prelude hiding (fail) @@ -84,7 +85,7 @@ fixtureTestTreeForFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> wi result <- TS.parseByteString TSP.tree_sitter_python fileContents let coreResult = fmap (Control.Effect.run . runFail - . runReader fp + . runReader (fromString @Py.SourcePath . Path.toString $ fp) . Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))) result for_ directives $ \directive -> do step (Directive.describe directive)