Eliminate inefficient RelPath->String->Text conversion.

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

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)

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)