diff --git a/WORKSPACE b/WORKSPACE index b245f45b6d..de4dad71ff 100644 --- a/WORKSPACE +++ b/WORKSPACE @@ -101,7 +101,6 @@ stack_snapshot( "optparse-applicative", "optparse-generic", "parsers", - "pathtype", "pretty-show", "pretty-simple", "prettyprinter", diff --git a/build/common.bzl b/build/common.bzl index 46663bcbca..7e3dfb2786 100644 --- a/build/common.bzl +++ b/build/common.bzl @@ -129,7 +129,6 @@ def semantic_language_library(language, name, srcs, ts_package = "", nodetypes = "@stackage//:generic-lens", "@stackage//:hashable", "@stackage//:lens", - "@stackage//:pathtype", "@stackage//:semilattices", "@stackage//:tree-sitter", "@stackage//:tree-sitter-" + language, @@ -154,7 +153,6 @@ def semantic_language_parsing_test(language, semantic_package = "", ts_package = "//semantic-ast", "@stackage//:bazel-runfiles", "@stackage//:hedgehog", - "@stackage//:pathtype", "@stackage//:tasty", "@stackage//:tasty-hedgehog", "@stackage//:tasty-hunit", diff --git a/semantic-analysis/BUILD.bazel b/semantic-analysis/BUILD.bazel index b4ae2ccdce..694311c3ec 100644 --- a/semantic-analysis/BUILD.bazel +++ b/semantic-analysis/BUILD.bazel @@ -30,7 +30,6 @@ haskell_library( "@stackage//:aeson", "@stackage//:fused-effects", "@stackage//:hashable", - "@stackage//:pathtype", "@stackage//:vector", ], ) diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal index 8a855119fc..6ec5082dd3 100644 --- a/semantic-analysis/semantic-analysis.cabal +++ b/semantic-analysis/semantic-analysis.cabal @@ -73,9 +73,9 @@ library , base >= 4.13 && < 5 , bytestring >= 0.10.8.2 && < 0.13 , containers ^>= 0.6 + , filepath , fused-effects ^>= 1.1 , hashable - , pathtype ^>= 0.8.1 , semantic-source ^>= 0.1.0.1 , text ^>= 1.2.3.1 , transformers ^>= 0.5 diff --git a/semantic-analysis/src/Analysis/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Analysis/Concrete.hs index b9db1b1c4c..1b447c10bc 100644 --- a/semantic-analysis/src/Analysis/Analysis/Concrete.hs +++ b/semantic-analysis/src/Analysis/Analysis/Concrete.hs @@ -35,10 +35,9 @@ import Data.Semigroup (Last(..)) import Data.Text as Text (Text) import Prelude hiding (fail) import Source.Span -import qualified System.Path as Path data Concrete - = Closure Path.AbsRelFile Span (Named (Concrete -> Concrete)) + = Closure FilePath Span (Named (Concrete -> Concrete)) | Unit | Bool Bool | Int Int @@ -93,7 +92,7 @@ vsubst n v = go data FO = FOVar Name - | FOClosure Path.AbsRelFile Span (Named FO) + | FOClosure FilePath Span (Named FO) | FOUnit | FOBool Bool | FOInt Int diff --git a/semantic-analysis/src/Analysis/Blob.hs b/semantic-analysis/src/Analysis/Blob.hs index 1a10152087..c43692f704 100644 --- a/semantic-analysis/src/Analysis/Blob.hs +++ b/semantic-analysis/src/Analysis/Blob.hs @@ -13,8 +13,6 @@ import Analysis.Reference as A import Data.Aeson import Source.Language as Language import Source.Source as Source -import qualified System.Path as Path -import qualified System.Path.PartClass as Path.PartClass -- | The source, path information, and language of a file read from disk. data Blob = Blob @@ -25,27 +23,27 @@ data Blob = Blob instance FromJSON Blob where parseJSON = withObject "Blob" $ \b -> do src <- b .: "content" - Right pth <- fmap Path.parse (b .: "path") + pth <- b .: "path" lang <- b .: "language" let lang' = if knownLanguage lang then lang else Language.forPath pth - pure (fromSource (pth :: Path.AbsRelFile) lang' src) + pure (fromSource (pth :: FilePath) lang' src) -- | Create a Blob from a provided path, language, and UTF-8 source. -- The resulting Blob's span is taken from the 'totalSpan' of the source. -fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob +fromSource :: FilePath -> Language -> Source -> Blob fromSource filepath language source - = Blob source (A.File (A.Reference (Path.toAbsRel filepath) (totalSpan source)) language) + = Blob source (A.File (A.Reference filepath (totalSpan source)) language) blobLanguage :: Blob -> Language blobLanguage = A.fileBody . blobFile -blobPath :: Blob -> Path.AbsRelFile +blobPath :: Blob -> FilePath blobPath = A.refPath . A.fileRef . blobFile -- | Show FilePath for error or json outputs. blobFilePath :: Blob -> String -blobFilePath = Path.toString . blobPath +blobFilePath = blobPath nullBlob :: Blob -> Bool nullBlob = Source.null . blobSource diff --git a/semantic-analysis/src/Analysis/File.hs b/semantic-analysis/src/Analysis/File.hs index 4b6cd5725a..4296e43275 100644 --- a/semantic-analysis/src/Analysis/File.hs +++ b/semantic-analysis/src/Analysis/File.hs @@ -14,8 +14,6 @@ import Data.Maybe (fromJust, listToMaybe) import GHC.Stack import Source.Language as Language import Source.Span -import qualified System.Path as Path -import qualified System.Path.PartClass as Path.PartClass -- Files @@ -29,10 +27,10 @@ data File a = File -- Constructors fromBody :: HasCallStack => a -> File a -fromBody body = File (A.Reference (Path.absRel (srcLocFile srcLoc)) (spanFromSrcLoc srcLoc)) body where +fromBody = File (A.Reference (srcLocFile srcLoc) (spanFromSrcLoc srcLoc)) where srcLoc = snd (fromJust (listToMaybe (getCallStack callStack))) -fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> File Language +fromPath :: FilePath -> File Language fromPath p = File (A.fromPath p) (Language.forPath p) diff --git a/semantic-analysis/src/Analysis/Project.hs b/semantic-analysis/src/Analysis/Project.hs index 1b59998730..fc75687bc7 100644 --- a/semantic-analysis/src/Analysis/Project.hs +++ b/semantic-analysis/src/Analysis/Project.hs @@ -12,19 +12,19 @@ import Analysis.File import Data.Text (Text) import qualified Data.Text as T import Source.Language -import qualified System.Path as Path +import System.FilePath -- | A 'Project' contains all the information that semantic needs -- to execute an analysis, diffing, or graphing pass. data Project = Project - { projectRootDir :: Path.AbsRelDir + { projectRootDir :: FilePath , projectBlobs :: [Blob] , projectLanguage :: Language - , projectExcludeDirs :: [Path.AbsRelDir] + , projectExcludeDirs :: [FilePath] } deriving (Eq, Show) projectName :: Project -> Text -projectName = T.pack . maybe "" Path.toString . Path.takeDirName . projectRootDir +projectName = T.pack . takeDirectory . projectRootDir projectExtensions :: Project -> [String] projectExtensions = extensionsForLanguage . projectLanguage diff --git a/semantic-analysis/src/Analysis/Reference.hs b/semantic-analysis/src/Analysis/Reference.hs index e73ab654bd..8e0c1f133f 100644 --- a/semantic-analysis/src/Analysis/Reference.hs +++ b/semantic-analysis/src/Analysis/Reference.hs @@ -6,13 +6,11 @@ module Analysis.Reference ) where import Source.Span -import System.Path as Path -import System.Path.PartClass as Path.PartClass -- Reference data Reference = Reference - { refPath :: Path.AbsRelFile + { refPath :: FilePath , refSpan :: Span } deriving (Eq, Ord, Show) @@ -21,5 +19,5 @@ data Reference = Reference -- Constructors -fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> Reference -fromPath p = Reference (Path.toAbsRel p) (point (Pos 0 0)) +fromPath :: FilePath -> Reference +fromPath p = Reference p (point (Pos 0 0)) diff --git a/semantic-analysis/src/Analysis/Syntax.hs b/semantic-analysis/src/Analysis/Syntax.hs index 78aaa90545..d5dfbdb806 100644 --- a/semantic-analysis/src/Analysis/Syntax.hs +++ b/semantic-analysis/src/Analysis/Syntax.hs @@ -43,7 +43,6 @@ import Data.Monoid (First (..)) import Data.String (IsString (..)) import Data.Text (Text) import qualified Data.Vector as V -import qualified System.Path as Path data Term = Var Name @@ -95,12 +94,12 @@ let' n v m = do parseFile :: (Has (Throw String) sig m, MonadIO m) => FilePath -> m (File Term) parseFile path = do contents <- liftIO (B.readFile path) - case (A.eitherDecodeWith A.json' (A.iparse parseGraph) contents) of + case A.eitherDecodeWith A.json' (A.iparse parseGraph) contents of Left (_, err) -> throwError err Right (_, Nothing) -> throwError "no root node found" -- FIXME: this should get the path to the source file, not the path to the JSON. -- FIXME: this should use the span of the source file, not an empty span. - Right (_, Just root) -> pure (File (Ref.fromPath (Path.absRel path)) root) + Right (_, Just root) -> pure (File (Ref.fromPath path) root) parseGraph :: A.Value -> A.Parser (IntMap.IntMap Term, Maybe Term) parseGraph = A.withArray "nodes" $ \ nodes -> do diff --git a/semantic-ast/BUILD.bazel b/semantic-ast/BUILD.bazel index daa7dfdfa3..73e6ab1f31 100644 --- a/semantic-ast/BUILD.bazel +++ b/semantic-ast/BUILD.bazel @@ -37,7 +37,6 @@ haskell_library( "@stackage//:fused-effects", "@stackage//:hedgehog", "@stackage//:optparse-applicative", - "@stackage//:pathtype", "@stackage//:pretty-simple", "@stackage//:tasty", "@stackage//:tasty-hedgehog", diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 1d6bf289d8..48653a7e7e 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -70,7 +70,6 @@ library , filepath ^>= 1.4.1 , fused-effects ^>= 1.1 , Glob ^>= 0.10.0 - , pathtype ^>= 0.8.1 , semantic-source ^>= 0.1.0.1 , tasty ^>= 1.2.3 , tasty-hunit ^>= 0.10.0.2 diff --git a/semantic-ast/src/AST/TestHelpers.hs b/semantic-ast/src/AST/TestHelpers.hs index ab28363e07..d1ce7c8ae7 100644 --- a/semantic-ast/src/AST/TestHelpers.hs +++ b/semantic-ast/src/AST/TestHelpers.hs @@ -17,19 +17,18 @@ import Data.Either import Data.Functor import Prelude hiding (takeWhile) import System.Exit (exitFailure) -import System.Path (()) -import qualified System.Path as Path -import qualified System.Path.Directory as Path +import System.Directory +import System.FilePath import System.FilePath.Glob import Test.Tasty import Test.Tasty.HUnit -testCorpus :: (ByteString -> IO (Either String (t a))) -> Path.AbsRelFile -> IO TestTree +testCorpus :: (ByteString -> IO (Either String (t a))) -> FilePath -> IO TestTree testCorpus parse path = do xs <- parseCorpusFile path case xs of - Left e -> print ("Failed to parse corpus: " <> show (Path.toString path) <> " " <> "Error: " <> show e) *> exitFailure - Right xs -> testGroup (Path.toString path) <$> traverse corpusTestCase xs + Left e -> print ("Failed to parse corpus: " <> path <> " " <> "Error: " <> show e) *> exitFailure + Right xs -> testGroup path <$> traverse corpusTestCase xs where corpusTestCase (CorpusExample name code) = testCase name . either (errMsg code) pass <$> parse code pass = const (pure ()) @@ -38,31 +37,28 @@ testCorpus parse path = do -- Depending on whether these tests are invoked via cabal run or cabal test, -- we might be in a project subdirectory or not, so let's make sure we're -- in project subdirectories as needed. -findCorpus :: Path.RelDir -> IO Path.RelDir +findCorpus :: FilePath -> IO FilePath findCorpus p = do - cwd <- Path.getCurrentDirectory - if Path.takeDirName cwd == Just (Path.relDir "haskell-tree-sitter") + cwd <- getCurrentDirectory + if takeDirectory cwd == "haskell-tree-sitter" then pure p - else pure (Path.relDir ".." p) + else pure (".." p) -- The path is expected to be relative to the language project. -readCorpusFiles :: Path.RelDir -> IO [Path.RelFile] +readCorpusFiles :: FilePath -> IO [FilePath] readCorpusFiles parent = do dir <- findCorpus parent - files <- globDir1 (compile "**/*.txt") (Path.toString dir) - pure (Path.relPath <$> files) + globDir1 (compile "**/*.txt") dir -readCorpusFiles' :: Path.AbsRelDir -> IO [Path.AbsRelFile] -readCorpusFiles' dir = do - files <- globDir1 (compile "**/*.txt") (Path.toString dir) - pure (Path.file <$> files) +readCorpusFiles' :: FilePath -> IO [FilePath] +readCorpusFiles' = globDir1 (compile "**/*.txt") data CorpusExample = CorpusExample { name :: String, code :: ByteString } deriving (Eq, Show) -parseCorpusFile :: Path.AbsRelFile -> IO (Either String [CorpusExample]) +parseCorpusFile :: FilePath -> IO (Either String [CorpusExample]) parseCorpusFile path = do - c <- Data.ByteString.readFile (Path.toString path) + c <- Data.ByteString.readFile path pure $ parseOnly corpusParser c corpusParser :: Parser [CorpusExample] diff --git a/semantic-ast/src/System/Path/Fixture.hs b/semantic-ast/src/System/Path/Fixture.hs index 84b04928e2..f0f14cb6ba 100644 --- a/semantic-ast/src/System/Path/Fixture.hs +++ b/semantic-ast/src/System/Path/Fixture.hs @@ -14,29 +14,28 @@ where import Control.Concurrent import GHC.Stack import System.IO -import qualified System.Path as Path -import System.Path (()) +import System.FilePath #if BAZEL_BUILD import qualified Bazel.Runfiles as Bazel type HasFixture = ( ?runfiles :: Bazel.Runfiles, - ?project :: Path.RelDir, + ?project :: FilePath, HasCallStack ) create :: IO Bazel.Runfiles create = Bazel.create -root :: HasFixture => Path.AbsRelDir -root = Path.absRel (Bazel.rlocation ?runfiles ".") +root :: HasFixture => FilePath +root = Bazel.rlocation ?runfiles "." -absRelFile :: (HasFixture) => String -> Path.AbsRelFile -absRelFile x = Path.toAbsRel (root Path.relDir "semantic" ?project Path.relFile x) +absRelFile :: (HasFixture) => String -> FilePath +absRelFile x = root "semantic" ?project x -absRelDir :: HasFixture => String -> Path.AbsRelDir -absRelDir x = Path.toAbsRel (root Path.relDir "semantic" ?project Path.relDir x) +absRelDir :: HasFixture => String -> FilePath +absRelDir x = root "semantic" ?project x #else @@ -46,11 +45,11 @@ type HasFixture = HasCallStack create :: IO () create = pure () -absRelFile :: String -> Path.AbsRelFile -absRelFile x = Path.absRel "semantic" Path.relFile x +absRelFile :: String -> FilePath +absRelFile x = "semantic" x -absRelDir :: String -> Path.AbsRelDir -absRelDir x = Path.absRel "semantic" Path.relDir x +absRelDir :: String -> FilePath +absRelDir x = "semantic" x #endif diff --git a/semantic-codeql/semantic-codeql.cabal b/semantic-codeql/semantic-codeql.cabal index f10b30f371..4b07d7ec3a 100644 --- a/semantic-codeql/semantic-codeql.cabal +++ b/semantic-codeql/semantic-codeql.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-codeql , tasty diff --git a/semantic-codeql/test/PreciseTest.hs b/semantic-codeql/test/PreciseTest.hs index 39c176db5c..31bbdcdc10 100644 --- a/semantic-codeql/test/PreciseTest.hs +++ b/semantic-codeql/test/PreciseTest.hs @@ -6,7 +6,6 @@ import AST.TestHelpers import AST.Unmarshal import qualified Language.CodeQL.AST as CodeQL import Language.CodeQL.Grammar -import qualified System.Path as Path import Test.Tasty import qualified System.Path.Fixture as Fixture @@ -14,12 +13,12 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-ql" + let ?project = "external/tree-sitter-ql" ?runfiles = rf let dirs = Fixture.absRelDir "test/corpus" #else - dirs <- Path.absRel <$> CodeQL.getTestCorpusDir + dirs <- CodeQL.getTestCorpusDir #endif let parse = parseByteString @CodeQL.Ql @() tree_sitter_ql diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index 773288c47a..6b26d0b74b 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-go , tasty diff --git a/semantic-go/test/PreciseTest.hs b/semantic-go/test/PreciseTest.hs index e83554a009..68a19bd9d2 100644 --- a/semantic-go/test/PreciseTest.hs +++ b/semantic-go/test/PreciseTest.hs @@ -7,7 +7,6 @@ import qualified Language.Go.AST as Go import Language.Go.Grammar import AST.TestHelpers import AST.Unmarshal -import qualified System.Path as Path import Test.Tasty import qualified System.Path.Fixture as Fixture @@ -15,11 +14,11 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-go" + let ?project = "external/tree-sitter-go" ?runfiles = rf let dirs = Fixture.absRelDir "corpus" #else - dirs <- Path.absRel <$> Go.getTestCorpusDir + dirs <- Go.getTestCorpusDir #endif readCorpusFiles' dirs diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index f24073e883..328bea7e5e 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-java , tasty diff --git a/semantic-java/test/PreciseTest.hs b/semantic-java/test/PreciseTest.hs index fd543bcd75..ed1ce3aafd 100644 --- a/semantic-java/test/PreciseTest.hs +++ b/semantic-java/test/PreciseTest.hs @@ -11,7 +11,6 @@ where import AST.TestHelpers import AST.Unmarshal import qualified Language.Java.AST as Java -import qualified System.Path as Path import qualified System.Path.Fixture as Fixture import Test.Tasty import TreeSitter.Java @@ -21,11 +20,11 @@ main = do #if BAZEL_BUILD rf <- Fixture.create -- - let ?project = Path.relDir "external/tree-sitter-java" + let ?project = "external/tree-sitter-java" ?runfiles = rf let dirs = Fixture.absRelDir "corpus" #else - dirs <- Path.absRel <$> Java.getTestCorpusDir + dirs <- Java.getTestCorpusDir #endif readCorpusFiles' dirs >>= traverse (testCorpus parse) diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 16de5e272c..d7b350e0d1 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -65,7 +65,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-json , tasty diff --git a/semantic-json/test/PreciseTest.hs b/semantic-json/test/PreciseTest.hs index 5d0b1be9f4..4fd7f01b8f 100644 --- a/semantic-json/test/PreciseTest.hs +++ b/semantic-json/test/PreciseTest.hs @@ -8,18 +8,17 @@ import AST.TestHelpers import AST.Unmarshal import qualified Language.JSON.AST as JSON import Language.JSON.Grammar -import qualified System.Path as Path import Test.Tasty main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/semantic-json" + let ?project = "external/semantic-json" ?runfiles = rf let dirs = Fixture.absRelDir "corpus" #else - dirs <- Path.absRel <$> JSON.getTestCorpusDir + dirs <- JSON.getTestCorpusDir #endif readCorpusFiles' dirs >>= traverse (testCorpus parse) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 3727e0c6be..7b1033f967 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -81,7 +81,6 @@ library -- , containers ^>= 0.6 -- , directory ^>= 1.3.3 -- , exceptions ^>= 0.10.2 - -- , pathtype ^>= 0.8.1 -- , pretty-show ^>= 1.9.5 -- , process ^>= 1.6.5 -- , resourcet ^>= 1.2.2 @@ -109,7 +108,6 @@ library -- , semantic-python -- -- , semantic-scope-graph -- , bytestring - -- , pathtype -- , tasty -- , tasty-hunit @@ -121,7 +119,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-python , tasty diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 9dfc0f1867..e85db58eb9 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -55,7 +55,7 @@ The graph should be -} -runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result) +runScopeGraph :: ToScopeGraph t => FilePath -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result) runScopeGraph p _src item = run . runSketch info $ scopeGraph item where info = ModuleInfo p "Python" mempty @@ -66,7 +66,7 @@ sampleGraphThing = do declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) pure Complete -graphFile :: Path.AbsRelFile -> IO (ScopeGraph.ScopeGraph Name, Result) +graphFile :: FilePath -> IO (ScopeGraph.ScopeGraph Name, Result) graphFile fp = do file <- ByteString.readFile $ Path.toString fp tree <- TS.parseByteString @Py.Term @Loc TSP.tree_sitter_python file @@ -76,14 +76,14 @@ graphFile fp = do assertSimpleAssignment :: HUnit.Assertion assertSimpleAssignment = do - let path = Path.absRel "semantic-python/test/fixtures/1-04-toplevel-assignment.py" + let path = "semantic-python/test/fixtures/1-04-toplevel-assignment.py" (result, Complete) <- graphFile path (expecto, Complete) <- runM $ runSketch (ModuleInfo path "Python" mempty) sampleGraphThing HUnit.assertEqual "Should work for simple case" expecto result assertSimpleReference :: HUnit.Assertion assertSimpleReference = do - let path = Path.absRel "semantic-python/test/fixtures/5-01-simple-reference.py" + let path = "semantic-python/test/fixtures/5-01-simple-reference.py" (result, Complete) <- graphFile path (expecto, Complete) <- runM $ runSketch (ModuleInfo path "Python" mempty) expectedReference @@ -115,7 +115,7 @@ expectedImportHole = do assertLexicalScope :: HUnit.Assertion assertLexicalScope = do - let path = Path.absRel "semantic-python/test/fixtures/5-02-simple-function.py" + let path = "semantic-python/test/fixtures/5-02-simple-function.py" let info = ModuleInfo path "Python" mempty (graph, _) <- graphFile path case run (runSketch info expectedLexicalScope) of @@ -132,7 +132,7 @@ expectedLexicalScope = do assertFunctionArg :: HUnit.Assertion assertFunctionArg = do - let path = Path.absRel "semantic-python/test/fixtures/5-03-function-argument.py" + let path = "semantic-python/test/fixtures/5-03-function-argument.py" (graph, _) <- graphFile path let info = ModuleInfo path "Python" mempty case run (runSketch info expectedFunctionArg) of @@ -154,7 +154,7 @@ expectedFunctionArg = do assertImportHole :: HUnit.Assertion assertImportHole = do - let path = Path.absRel "semantic-python/test/fixtures/cheese/6-01-imports.py" + let path = "semantic-python/test/fixtures/cheese/6-01-imports.py" (graph, _) <- graphFile path let info = ModuleInfo path "Python" mempty case run (runSketch info expectedImportHole) of @@ -163,7 +163,7 @@ assertImportHole = do assertQualifiedImport :: HUnit.Assertion assertQualifiedImport = do - let path = Path.absRel "semantic-python/test/fixtures/cheese/6-01-qualified-imports.py" + let path = "semantic-python/test/fixtures/cheese/6-01-qualified-imports.py" (graph, _) <- graphFile path let info = ModuleInfo path "Python" mempty case run (runSketch info expectedQualifiedImport) of @@ -173,8 +173,8 @@ assertQualifiedImport = do main :: IO () main = do -- make sure we're in the root directory so the paths resolve properly - cwd <- Path.getCurrentDirectory - when (Path.takeDirName cwd == Just (Path.relDir "semantic-python")) + cwd <- getCurrentDirectory + when (takeDirectory cwd == Just (Path.relDir "semantic-python")) (Path.setCurrentDirectory (cwd Path.relDir "..")) Tasty.defaultMain $ diff --git a/semantic-python/test/CoreTest.hs b/semantic-python/test/CoreTest.hs index 5b0788f1f3..2a7da3aec1 100644 --- a/semantic-python/test/CoreTest.hs +++ b/semantic-python/test/CoreTest.hs @@ -35,9 +35,8 @@ import Syntax.Term import Syntax.Var (closed) import System.Directory import System.Exit -import System.Path (()) -import qualified System.Path as Path -import qualified System.Path.Directory as Path +import System.FilePath +import System.Directory import qualified Text.Trifecta as Trifecta import qualified Language.Python.Grammar as TSP import qualified AST.Unmarshal as TS @@ -81,7 +80,7 @@ assertTreeEqual :: Term Core Name -> Term Core Name -> HUnit.Assertion assertTreeEqual t item = HUnit.assertEqual ("got (pretty)" <> showCore item) t item -checkPythonFile :: HasCallStack => Path.RelFile -> Tasty.TestTree +checkPythonFile :: HasCallStack => FilePath -> Tasty.TestTree checkPythonFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFrozenCallStack $ do -- Extract the directives and the core associated with the provided file let fullPath = Path.relDir "semantic-python/test/fixtures" fp diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs index 6ea016d695..f07a992e8e 100644 --- a/semantic-python/test/Directive.hs +++ b/semantic-python/test/Directive.hs @@ -57,7 +57,7 @@ data Directive = Tree (Term Core Name) -- | @# CHECK-TREE: core@ deriving (Eq, Show) -- | Extract all directives from a file. -readDirectivesFromFile :: Path.Class.AbsRel ar => Path.File ar -> IO [Directive] +readDirectivesFromFile :: Path.Class.AbsRel ar => FilePath -> IO [Directive] readDirectivesFromFile = runResourceT . Stream.toList_ diff --git a/semantic-python/test/Instances.hs b/semantic-python/test/Instances.hs index d851f3f408..d0e9fb9146 100644 --- a/semantic-python/test/Instances.hs +++ b/semantic-python/test/Instances.hs @@ -12,7 +12,6 @@ module Instances () where import Analysis.File import Data.Aeson import Data.Text (pack) -import qualified System.Path as Path instance ToJSON a => ToJSON (File a) where toJSON File{filePath, fileSpan, fileBody} = object @@ -21,5 +20,5 @@ instance ToJSON a => ToJSON (File a) where , "body" .= fileBody ] -instance ToJSON Path.AbsRelFile where - toJSON p = toJSON (pack (Path.toString p)) +instance ToJSON FilePath where + toJSON p = toJSON (pack p) diff --git a/semantic-python/test/PreciseTest.hs b/semantic-python/test/PreciseTest.hs index fad9f5fcb6..3fdf6a2e6a 100644 --- a/semantic-python/test/PreciseTest.hs +++ b/semantic-python/test/PreciseTest.hs @@ -2,7 +2,6 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} module Main (main) where -import qualified System.Path as Path import Test.Tasty import TreeSitter.Python import qualified Language.Python.AST as Py @@ -14,11 +13,11 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-python" + let ?project = "external/tree-sitter-python" ?runfiles = rf - let dirs = Fixture.absRelDir "test/corpus" + let dirs = "test/corpus" #else - dirs <- Path.absRel <$> Py.getTestCorpusDir + dirs <- Py.getTestCorpusDir #endif let parse = parseByteString @Py.Module @() tree_sitter_python diff --git a/semantic-ruby/bench/Parsing.hs b/semantic-ruby/bench/Parsing.hs index 550329270b..db8811f739 100644 --- a/semantic-ruby/bench/Parsing.hs +++ b/semantic-ruby/bench/Parsing.hs @@ -8,7 +8,6 @@ import Data.Foldable import Gauge import System.Exit (die) import System.FilePath.Glob -import qualified System.Path as Path import Language.Ruby import qualified Language.Ruby.AST as Rb import AST.Unmarshal @@ -18,14 +17,13 @@ benchmarks = bgroup "parsing" [ rubyBenchmarks ] rubyBenchmarks :: Benchmark rubyBenchmarks = bench "ruby" $ parseAllFiles dir "*.rb" - where dir = Path.relDir "../semantic/tmp/ruby-examples/ruby_spec/command_line" + where dir = "../semantic/tmp/ruby-examples/ruby_spec/command_line" -parseAllFiles :: Path.RelDir -> String -> Benchmarkable +parseAllFiles :: FilePath -> String -> Benchmarkable parseAllFiles dir glob = nfIO $ do - files <- globDir1 (compile glob) (Path.toString dir) - let paths = Path.relFile <$> files - when (null paths) (die $ "No files found in " <> (Path.toString dir)) - for_ paths $ \ file -> do + files <- globDir1 (compile glob) dir + when (null files) (die $ "No files found in " <> dir) + for_ files $ \ file -> do -- print (Path.toString file) - contents <- B.readFile (Path.toString file) + contents <- B.readFile file either die pure =<< parseByteString @Rb.Program @() tree_sitter_ruby contents diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 8d3e33fd0a..fc05a63ee9 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-ruby , tasty @@ -86,7 +85,6 @@ executable benchmarks , bytestring , gauge ^>= 0.2.5 , Glob - , pathtype ^>= 0.8.1 , semantic-ast , semantic-ruby , tree-sitter-ruby ^>= 0.5.0.2 diff --git a/semantic-ruby/test/PreciseTest.hs b/semantic-ruby/test/PreciseTest.hs index e130db2f4f..bc6cdef0b2 100644 --- a/semantic-ruby/test/PreciseTest.hs +++ b/semantic-ruby/test/PreciseTest.hs @@ -6,7 +6,6 @@ import TreeSitter.Ruby import AST.TestHelpers import AST.Unmarshal import qualified Language.Ruby.AST as Ruby -import qualified System.Path as Path import Test.Tasty import qualified System.Path.Fixture as Fixture import System.IO @@ -16,11 +15,11 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-ruby" + let ?project = "external/tree-sitter-ruby" ?runfiles = rf let dirs = Fixture.absRelDir "test/corpus" #else - dirs <- Path.absRel <$> Ruby.getTestCorpusDir + dirs <- Ruby.getTestCorpusDir #endif readCorpusFiles' dirs >>= traverse (testCorpus parse) diff --git a/semantic-rust/semantic-rust.cabal b/semantic-rust/semantic-rust.cabal index a3f229e687..05173b2fbe 100644 --- a/semantic-rust/semantic-rust.cabal +++ b/semantic-rust/semantic-rust.cabal @@ -67,8 +67,8 @@ test-suite test main-is: Test.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-rust + , filepath , tasty , tree-sitter-rust ^>= 0.1.0.0 diff --git a/semantic-rust/test/Test.hs b/semantic-rust/test/Test.hs index 3721db8475..92b3797455 100644 --- a/semantic-rust/test/Test.hs +++ b/semantic-rust/test/Test.hs @@ -6,21 +6,21 @@ module Main (main) where import AST.TestHelpers import AST.Unmarshal (parseByteString) +import Control.Monad (liftM) import Language.Rust.Grammar import qualified Language.Rust.AST as Rust -import qualified System.Path as Path +import System.FilePath import Test.Tasty -import Control.Monad (liftM) main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-python" + let ?project = "external/tree-sitter-python" ?runfiles = rf let dirs = Fixture.absRelDir "test/corpus" #else - dirs <- Path.absRel <$> Rust.getTestCorpusDir + dirs <- Rust.getTestCorpusDir #endif @@ -30,7 +30,7 @@ main = do where parse = parseByteString @Rust.SourceFile @() tree_sitter_rust excludeMacrosCorpus l = liftM (filter (f "expressions") ) l - where f p bn = p /= (Path.toString . Path.takeBaseName) bn + where f p bn = p /= takeBaseName bn tests :: [TestTree] -> TestTree tests = testGroup "tree-sitter-rust corpus tests" diff --git a/semantic-scope-graph/BUILD.bazel b/semantic-scope-graph/BUILD.bazel index d1c60951e3..eb4645e3c5 100644 --- a/semantic-scope-graph/BUILD.bazel +++ b/semantic-scope-graph/BUILD.bazel @@ -31,7 +31,6 @@ haskell_library( "@stackage//:generic-lens", "@stackage//:hashable", "@stackage//:lens", - "@stackage//:pathtype", "@stackage//:semilattices", ], ) diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index ba94c61044..29ba572d9e 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -43,7 +43,6 @@ library , generic-lens , hashable , lens - , pathtype , semantic-analysis , semantic-source ^>= 0.1.0.1 , semilattices diff --git a/semantic-scope-graph/src/Data/Module.hs b/semantic-scope-graph/src/Data/Module.hs index 885bc96b60..22befde89a 100644 --- a/semantic-scope-graph/src/Data/Module.hs +++ b/semantic-scope-graph/src/Data/Module.hs @@ -14,7 +14,6 @@ import Data.Maybe import Data.Semilattice.Lower import Data.Text (Text) import GHC.Stack -import qualified System.Path as Path data Module body = Module { moduleInfo :: ModuleInfo, moduleBody :: body } deriving (Eq, Foldable, Functor, Ord, Traversable) @@ -23,20 +22,20 @@ instance Show body => Show (Module body) where showsPrec d Module{..} = showsBinaryWith showsPrec showsPrec "Module" d (modulePath moduleInfo) moduleBody -type ModulePath = Path.AbsRelFile +type ModulePath = FilePath data ModuleInfo = ModuleInfo { modulePath :: ModulePath, moduleLanguage :: Text, moduleOid :: Text } deriving (Eq, Ord) instance Lower ModuleInfo where - lowerBound = ModuleInfo (Path.toAbsRel Path.emptyFile) "Unknown" mempty + lowerBound = ModuleInfo "" "Unknown" mempty instance Show ModuleInfo where showsPrec d = showsUnaryWith showsPrec "ModuleInfo" d . modulePath moduleInfoFromSrcLoc :: SrcLoc -> ModuleInfo -moduleInfoFromSrcLoc loc = ModuleInfo (Path.absRel $ srcLocModule loc) "Unknown" mempty +moduleInfoFromSrcLoc loc = ModuleInfo (srcLocModule loc) "Unknown" mempty -- | Produce 'ModuleInfo' from the top location on the Haskell call stack (i.e. the file where the call to 'moduleInfoFromCallStack' was made). moduleInfoFromCallStack :: HasCallStack => ModuleInfo -moduleInfoFromCallStack = maybe (ModuleInfo (Path.absRel "?") "Unknown" mempty) (moduleInfoFromSrcLoc . snd) (listToMaybe (getCallStack callStack)) +moduleInfoFromCallStack = maybe (ModuleInfo "" "Unknown" mempty) (moduleInfoFromSrcLoc . snd) (listToMaybe (getCallStack callStack)) diff --git a/semantic-source/BUILD.bazel b/semantic-source/BUILD.bazel index aca9f16210..15f90435ac 100644 --- a/semantic-source/BUILD.bazel +++ b/semantic-source/BUILD.bazel @@ -27,10 +27,9 @@ haskell_library( "//:deepseq", "//:filepath", "//:text", - "@stackage//:lingo", "@stackage//:aeson", "@stackage//:hashable", - "@stackage//:pathtype", + "@stackage//:lingo", "@stackage//:semilattices", ], ) diff --git a/semantic-source/semantic-source.cabal b/semantic-source/semantic-source.cabal index 94ef50c96d..ad567cf503 100644 --- a/semantic-source/semantic-source.cabal +++ b/semantic-source/semantic-source.cabal @@ -64,7 +64,6 @@ library , containers ^>= 0.6.2 , hashable >= 1.2.7 && < 1.4 , lingo ^>= 0.5.0.3 - , pathtype ^>= 0.8.1 , semilattices ^>= 0.0.0.3 , text ^>= 1.2.3.2 hs-source-dirs: src diff --git a/semantic-source/src/Source/Language.hs b/semantic-source/src/Source/Language.hs index 84140aede6..ee6429b6e1 100644 --- a/semantic-source/src/Source/Language.hs +++ b/semantic-source/src/Source/Language.hs @@ -20,8 +20,6 @@ import qualified Data.Languages as Lingo import qualified Data.Map.Strict as Map import qualified Data.Text as T import GHC.Generics (Generic) -import qualified System.Path as Path -import qualified System.Path.PartClass as Path.PartClass -- | The various languages we support. data Language @@ -96,13 +94,13 @@ knownLanguage = (/= Unknown) extensionsForLanguage :: Language -> [String] extensionsForLanguage language = fmap T.unpack (maybe mempty Lingo.languageExtensions (Map.lookup (languageToText language) Lingo.languages)) -forPath :: Path.PartClass.AbsRel ar => Path.File ar -> Language +forPath :: FilePath -> Language forPath path = let spurious lang = lang `elem` [ "Hack" -- .php files , "GCC Machine Description" -- .md files , "XML" -- .tsx files ] - allResults = Lingo.languageName <$> Lingo.languagesForPath (Path.toString path) + allResults = Lingo.languageName <$> Lingo.languagesForPath path in case filter (not . spurious) allResults of [result] -> textToLanguage result _ -> Unknown diff --git a/semantic-tsx/semantic-tsx.cabal b/semantic-tsx/semantic-tsx.cabal index d8abd95ea5..818c5cafcc 100644 --- a/semantic-tsx/semantic-tsx.cabal +++ b/semantic-tsx/semantic-tsx.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-tsx , tasty diff --git a/semantic-tsx/test/PreciseTest.hs b/semantic-tsx/test/PreciseTest.hs index c49a893296..b4d46a1e1a 100644 --- a/semantic-tsx/test/PreciseTest.hs +++ b/semantic-tsx/test/PreciseTest.hs @@ -7,7 +7,6 @@ import TreeSitter.TSX import AST.TestHelpers import AST.Unmarshal import qualified Language.TSX.AST as Tsx -import qualified System.Path as Path import Test.Tasty import qualified System.Path.Fixture as Fixture @@ -15,11 +14,11 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/semantic-typescript" + let ?project = "external/semantic-typescript" ?runfiles = rf let dirs = Fixture.absRelDir "tsx/corpus" #else - dirs <- Path.absRel <$> Tsx.getTestCorpusDir + dirs <- Tsx.getTestCorpusDir #endif readCorpusFiles' dirs diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index a69595dea1..3cdbccb37a 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-typescript , tasty diff --git a/semantic-typescript/test/PreciseTest.hs b/semantic-typescript/test/PreciseTest.hs index 60132f1dac..4862e85dc4 100644 --- a/semantic-typescript/test/PreciseTest.hs +++ b/semantic-typescript/test/PreciseTest.hs @@ -6,7 +6,6 @@ import TreeSitter.TypeScript import AST.TestHelpers import AST.Unmarshal import qualified Language.TypeScript.AST as Ts -import qualified System.Path as Path import Test.Tasty import qualified System.Path.Fixture as Fixture @@ -14,11 +13,11 @@ main :: IO () main = do #if BAZEL_BUILD rf <- Fixture.create - let ?project = Path.relDir "external/tree-sitter-typescript" + let ?project = "external/tree-sitter-typescript" ?runfiles = rf let dirs = Fixture.absRelDir "typescript/corpus" #else - dirs <- Path.absRel <$> Ts.getTestCorpusDir + dirs <- Ts.getTestCorpusDir #endif readCorpusFiles' dirs diff --git a/semantic/BUILD.bazel b/semantic/BUILD.bazel index f7b6528e75..48fa3f8359 100644 --- a/semantic/BUILD.bazel +++ b/semantic/BUILD.bazel @@ -37,7 +37,6 @@ semantic_common_dependencies = [ "@stackage//:fused-effects-exceptions", "@stackage//:hashable", "@stackage//:network", - "@stackage//:pathtype", "@stackage//:recursion-schemes", "@stackage//:safe-exceptions", "@stackage//:scientific", @@ -124,7 +123,6 @@ haskell_binary( "@stackage//:Glob", "@stackage//:fused-effects", "@stackage//:gauge", - "@stackage//:pathtype", ], ) diff --git a/semantic/bench/Tagging.hs b/semantic/bench/Tagging.hs index 1327d18c0b..ff23125808 100644 --- a/semantic/bench/Tagging.hs +++ b/semantic/bench/Tagging.hs @@ -16,7 +16,6 @@ import Control.Monad import Data.Foldable import Gauge import System.FilePath.Glob -import qualified System.Path as Path import qualified Analysis.File as File import Data.Flag @@ -28,8 +27,8 @@ import Semantic.Task.Files benchmarks :: Benchmark benchmarks = bgroup "tagging" - [ bench "jquery" $ runTagging' (Path.relFile "semantic/test/fixtures/jquery-3.5.1.min.js") - , bench "sinatra" $ runTagging' (Path.relFile "semantic/test/fixtures/base.rb") + [ bench "jquery" $ runTagging' "semantic/test/fixtures/jquery-3.5.1.min.js" + , bench "sinatra" $ runTagging' "semantic/test/fixtures/base.rb" ] -- Feel free to turn these on or write other benchmarks -- [ pythonBenchmarks @@ -37,7 +36,7 @@ benchmarks = bgroup "tagging" -- , rubyBenchmarks -- ] -runTagging' :: Path.RelFile -> Benchmarkable +runTagging' :: FilePath -> Benchmarkable runTagging' path = nfIO . withOptions testOptions $ \ config logger statter -> do let session = TaskSession config "-" False logger statter runTask session (runParse (parseSymbolsFilePath path)) >>= either throwIO pure @@ -60,7 +59,7 @@ rubyBenchmarks = bgroup "ruby" ] where dir = Path.relDir "tmp/ruby-examples/ruby_spec/command_line" -runTagging :: Path.RelDir -> String -> Benchmarkable +runTagging :: FilePath -> String -> Benchmarkable runTagging dir glob = nfIO . withOptions testOptions $ \ config logger statter -> do let session = TaskSession config "-" False logger statter files <- globDir1 (compile glob) (Path.toString dir) @@ -73,7 +72,7 @@ parseSymbolsFilePath :: , Has Parse sig m , Has Files sig m ) - => Path.RelFile + => FilePath -> m ParseTreeSymbolResponse parseSymbolsFilePath path = readBlob (File.fromPath path) >>= parseSymbols . pure @[] diff --git a/semantic/semantic.cabal b/semantic/semantic.cabal index 0e0938b321..8465abb62b 100644 --- a/semantic/semantic.cabal +++ b/semantic/semantic.cabal @@ -110,6 +110,7 @@ library , base >= 4.13 && < 5 , bytestring ^>= 0.10.8.2 , containers ^>= 0.6.0.1 + , directory , directory-tree ^>= 0.12.1 , filepath ^>= 1.4.2.1 , fused-effects ^>= 1.1 @@ -120,7 +121,6 @@ library , network ^>= 2.8.0.0 , network-uri ^>= 2.6.1.0 , optparse-applicative >= 0.14.3 && < 0.16 - , pathtype ^>= 0.8.1 , pretty-show ^>= 1.9.5 , proto-lens >= 0.5 && < 0.8 , semantic-analysis ^>= 0 @@ -184,13 +184,14 @@ test-suite test , algebraic-graphs ^>= 0.3 , base >= 4.13 && < 5 , bytestring ^>= 0.10.8.2 + , directory + , filepath , fused-effects , Glob ^>= 0.10.0 , hedgehog ^>= 1 , hspec >= 2.6 && <3 , hspec-expectations ^>= 0.8.2 , network ^>= 2.8.0.0 - , pathtype ^>= 0.8.1 , semantic , semantic-analysis , semantic-ast @@ -212,10 +213,11 @@ test-suite parse-examples build-depends: , async ^>= 2.2.1 , base + , directory + , filepath , fused-effects ^>= 1.1 , Glob , lens >= 4.17 && < 4.20 - , pathtype ^>= 0.8.1 , process ^>= 1.6.3.0 , semantic , semantic-analysis ^>= 0 @@ -237,7 +239,6 @@ benchmark benchmarks , fused-effects ^>= 1.1 , gauge ^>= 0.2.5 , Glob - , pathtype ^>= 0.8.1 , semantic , semantic-analysis ^>= 0 , semantic-proto diff --git a/semantic/src/Data/Blob.hs b/semantic/src/Data/Blob.hs index 3565369f77..96361023c6 100644 --- a/semantic/src/Data/Blob.hs +++ b/semantic/src/Data/Blob.hs @@ -33,10 +33,10 @@ import qualified Data.ByteString.Lazy as BL import Data.Edit import Data.Maybe.Exts import Data.Module -import Data.List (stripPrefix) +import System.FilePath import GHC.Generics (Generic) import Source.Language as Language -import qualified System.Path as Path +import qualified System.FilePath as Path newtype Blobs a = Blobs { blobs :: [a] } @@ -46,10 +46,10 @@ decodeBlobs :: BL.ByteString -> Either String [Blob] decodeBlobs = fmap blobs <$> eitherDecode -- | An exception indicating that we’ve tried to diff or parse a blob of unknown language. -newtype NoLanguageForBlob = NoLanguageForBlob Path.AbsRelFile +newtype NoLanguageForBlob = NoLanguageForBlob FilePath deriving (Eq, Exception, Ord, Show) -noLanguageForBlob :: Has (Error SomeException) sig m => Path.AbsRelFile -> m a +noLanguageForBlob :: Has (Error SomeException) sig m => FilePath -> m a noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPath)) -- | Construct a 'Module' for a 'Blob' and @term@, relative to some root 'FilePath'. @@ -58,16 +58,8 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo -> term -- ^ The @term@ representing the body of the module. -> Module term -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any. moduleForBlob rootDir b = Module info - where root = maybe (Path.takeDirectory $ blobPath b) Path.absRel rootDir - info = ModuleInfo (dropRelative root (blobPath b)) (languageToText (blobLanguage b)) mempty - -dropRelative :: Path.AbsRelDir -> Path.AbsRelFile -> Path.AbsRelFile -dropRelative a' b' = case as `stripPrefix` bs of - Just rs | ra == rb -> Path.toAbsRel $ (foldl (Path.) Path.currentDir rs) Path. bf - _ -> b' - where (ra, as, _) = Path.splitPath $ Path.normalise a' - (rb, bs, _) = Path.splitPath $ Path.normalise $ Path.takeDirectory b' - bf = Path.takeFileName b' + where root = maybe (Path.takeDirectory $ blobPath b) id rootDir + info = ModuleInfo (makeRelative root (blobPath b)) (languageToText (blobLanguage b)) mempty -- | Represents a blobs suitable for diffing which can be either a blob to -- delete, a blob to insert, or a pair of blobs to diff. @@ -87,7 +79,7 @@ languageForBlobPair = mergeEdit combine . bimap blobLanguage blobLanguage where | a == Unknown || b == Unknown = Unknown | otherwise = b -pathForBlobPair :: BlobPair -> Path.AbsRelFile +pathForBlobPair :: BlobPair -> FilePath pathForBlobPair = blobPath . mergeEdit (const id) languageTagForBlobPair :: BlobPair -> [(String, String)] diff --git a/semantic/src/Data/Blob/IO.hs b/semantic/src/Data/Blob/IO.hs index 584d64d9a8..5f465e9d3d 100644 --- a/semantic/src/Data/Blob/IO.hs +++ b/semantic/src/Data/Blob/IO.hs @@ -16,30 +16,27 @@ import Analysis.Reference import Control.Monad.IO.Class import Data.Blob import qualified Data.ByteString as B +import System.FilePath +import System.Directory import Data.Maybe.Exts import Semantic.IO import Source.Language import qualified Source.Source as Source import Source.Span -import qualified System.Path as Path -- | Deprecated: this has very weird semantics. readProjectFromPaths :: MonadIO m - => Maybe Path.AbsRelDir -- ^ An optional root directory for the project - -> Path.AbsRelFileDir -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory. + => Maybe FilePath -- ^ An optional root directory for the project + -> FilePath -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory. -> Language - -> [Path.AbsRelDir] -- ^ Directories to exclude. + -> [FilePath] -- ^ Directories to exclude. -> m Project readProjectFromPaths maybeRoot path lang excludeDirs = do - let rootDir :: Path.AbsRelDir - rootDir = case maybeRoot >>= Path.fromAbsRel of + let rootDir :: FilePath + rootDir = case maybeRoot of -- If we were provided a root directory, use that. Just root -> root - Nothing -> case Path.fileFromFileDir path of - -- If we weren't and the path is a file, drop its file name. - Just fp -> Path.takeDirectory fp - -- Otherwise, load from the path. - Nothing -> Path.dirFromFileDir path + Nothing -> takeDirectory path paths <- liftIO $ findFilesInDir rootDir exts excludeDirs blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths @@ -51,9 +48,9 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do -- | Read a utf8-encoded file to a 'Blob'. readBlobFromFile :: MonadIO m => File Language -> m (Maybe Blob) -readBlobFromFile (File (Reference (Path.toString -> "/dev/null") _) _) = pure Nothing +readBlobFromFile (File (Reference "/dev/null" _) _) = pure Nothing readBlobFromFile file@(File (Reference path _) _language) = do - raw <- liftIO $ B.readFile (Path.toString path) + raw <- liftIO $ B.readFile path let newblob = Blob (Source.fromUTF8 raw) file pure . Just $ newblob @@ -64,7 +61,7 @@ readBlobFromFile' file = do maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile -- | Read a blob from the provided absolute or relative path , failing if it can't be found. -readBlobFromPath :: (MonadFail m, MonadIO m) => Path.AbsRelFile -> m Blob +readBlobFromPath :: (MonadFail m, MonadIO m) => FilePath -> m Blob readBlobFromPath = readBlobFromFile' . File.fromPath readFilePair :: MonadIO m => File Language -> File Language -> m BlobPair diff --git a/semantic/src/Data/Handle.hs b/semantic/src/Data/Handle.hs index dab9fc9b25..7062cf8421 100644 --- a/semantic/src/Data/Handle.hs +++ b/semantic/src/Data/Handle.hs @@ -23,7 +23,6 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified System.IO as IO -import qualified System.Path as Path import Data.Blob data Handle mode where @@ -46,8 +45,8 @@ stdout = WriteHandle IO.stdout stderr :: Handle 'IO.WriteMode stderr = WriteHandle IO.stderr -openFileForReading :: Path.AbsRelFile -> IO (Handle 'IO.ReadMode) -openFileForReading path = ReadHandle <$> IO.openFile (Path.toString path) IO.ReadMode +openFileForReading :: FilePath -> IO (Handle 'IO.ReadMode) +openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode -- | Read JSON encoded blobs from a handle. readBlobsFromHandle :: MonadIO m => Handle 'IO.ReadMode -> m [Blob] diff --git a/semantic/src/Semantic/Api/Bridge.hs b/semantic/src/Semantic/Api/Bridge.hs index eedb492236..79eac5c77f 100644 --- a/semantic/src/Semantic/Api/Bridge.hs +++ b/semantic/src/Semantic/Api/Bridge.hs @@ -12,7 +12,6 @@ import Analysis.File import Analysis.Reference import Control.Lens import qualified Data.Blob as Data -import Data.Either import Data.ProtoLens (defMessage) import qualified Data.Text as T import Data.Text.Lens @@ -22,7 +21,6 @@ import qualified Source.Language as Data import qualified Source.Range as Source import qualified Source.Source as Source (fromText, toText, totalSpan) import qualified Source.Span as Source -import qualified System.Path as Path -- | An @APIBridge x y@ instance describes an isomorphism between @x@ and @y@. -- This is suitable for types such as 'Pos' which are representationally equivalent @@ -80,7 +78,7 @@ instance APIBridge API.Blob Data.Blob where & P.language .~ (bridging # Data.blobLanguage b) apiBlobToBlob blob = let src = blob^.content.to Source.fromText - pth = fromRight (Path.toAbsRel Path.emptyFile) (blob^.path._Text.to Path.parse) + pth = blob^.path._Text in Data.Blob { blobSource = src , blobFile = File (Reference pth (Source.totalSpan src)) (blob^.language.bridging) diff --git a/semantic/src/Semantic/CLI.hs b/semantic/src/Semantic/CLI.hs index dba5d8d20b..3532ca9bc6 100644 --- a/semantic/src/Semantic/CLI.hs +++ b/semantic/src/Semantic/CLI.hs @@ -4,12 +4,14 @@ module Semantic.CLI (main) where import qualified Analysis.File as File import qualified Control.Carrier.Parse.Measured as Parse +import Control.Concurrent (mkWeakThreadId, myThreadId) import Control.Exception import qualified Data.Flag as Flag import Data.Foldable import Data.Handle import Data.List (intercalate) import Options.Applicative hiding (style) +import Proto.Semantic_JSON () import Semantic.Api hiding (File) import Semantic.Config import qualified Semantic.Task as Task @@ -20,13 +22,8 @@ import Semantic.Version import Serializing.Format import qualified Source.Language as Language import System.Exit (die) -import qualified System.Path as Path -import qualified System.Path.PartClass as Path.PartClass - -import Control.Concurrent (mkWeakThreadId, myThreadId) -import Proto.Semantic_JSON () -import System.Mem.Weak (deRefWeak) -import System.Posix.Signals +import System.Mem.Weak (deRefWeak) +import System.Posix.Signals newtype SignalException = SignalException Signal deriving (Show) @@ -77,7 +74,7 @@ optionsParser = do argumentsParser :: Parser (Parse.ParseC Task.TaskC ()) argumentsParser = do subparser <- hsubparser parseCommand - output <- ToPath <$> pathOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) + output <- ToPath <$> option path (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) pure $ subparser >>= Task.write output parseCommand :: Mod CommandFields (Parse.ParseC Task.TaskC Builder) @@ -112,11 +109,8 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa filePathReader :: ReadM (File.File Language.Language) filePathReader = File.fromPath <$> path -path :: (Path.PartClass.FileDir fd) => ReadM (Path.AbsRel fd) -path = eitherReader Path.parse - -pathOption :: Path.PartClass.FileDir fd => Mod OptionFields (Path.AbsRel fd) -> Parser (Path.AbsRel fd) -pathOption = option path +path :: ReadM String +path = str options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options))) diff --git a/semantic/src/Semantic/IO.hs b/semantic/src/Semantic/IO.hs index 5ef24ab7aa..d1787093d0 100644 --- a/semantic/src/Semantic/IO.hs +++ b/semantic/src/Semantic/IO.hs @@ -13,22 +13,20 @@ import Control.Monad.IO.Class import System.Directory.Tree (AnchoredDirTree (..)) import qualified System.Directory.Tree as Tree import System.FilePath -import qualified System.Path as Path -import qualified System.Path.PartClass as Path.PartClass pathIsMinified :: FilePath -> Bool pathIsMinified = isExtensionOf ".min.js" -- Recursively find files in a directory. -findFilesInDir :: (Path.PartClass.AbsRel ar, MonadIO m) => Path.Dir ar -> [String] -> [Path.Dir ar] -> m [Path.File ar] +findFilesInDir :: (MonadIO m) => FilePath -> [String] -> [FilePath] -> m [FilePath] findFilesInDir path exts excludeDirs = do - _:/dir <- liftIO $ Tree.build (Path.toString path) + _:/dir <- liftIO $ Tree.build path pure $ (onlyFiles . Tree.filterDir (withExtensions exts) . Tree.filterDir (notIn excludeDirs)) dir where -- Build a list of only FilePath's (remove directories and failures) onlyFiles (Tree.Dir _ fs) = concatMap onlyFiles fs onlyFiles (Tree.Failed _ _) = [] - onlyFiles (Tree.File _ f) = [Path.file f] + onlyFiles (Tree.File _ f) = [f] -- Predicate for Files with one of the extensions in 'exts'. withExtensions exts (Tree.File n _) @@ -40,6 +38,6 @@ findFilesInDir path exts excludeDirs = do -- Predicate for contents NOT in a directory notIn dirs (Tree.Dir n _) | (x:_) <- n, x == '.' = False -- Don't include directories that start with '.'. - | Path.dir n `elem` dirs = False + | n `elem` dirs = False | otherwise = True notIn _ _ = True diff --git a/semantic/src/Semantic/Task/Files.hs b/semantic/src/Semantic/Task/Files.hs index 3ce2751338..d2b664ec1b 100644 --- a/semantic/src/Semantic/Task/Files.hs +++ b/semantic/src/Semantic/Task/Files.hs @@ -36,9 +36,7 @@ import Data.Handle import Prelude hiding (readFile) import Semantic.IO import Source.Language (Language) -import qualified System.IO as IO hiding (withBinaryFile) -import qualified System.Path as Path -import qualified System.Path.IO as IO (withBinaryFile) +import qualified System.IO as IO data Source blob where FromPath :: File Language -> Source Blob @@ -46,13 +44,13 @@ data Source blob where FromPathPair :: File Language -> File Language -> Source BlobPair FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair] -data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode) +data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode) -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's. data Files (m :: * -> *) k where Read :: Source a -> Files m a - ReadProject :: Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> Files m Project - FindFiles :: Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> Files m [Path.AbsRelFile] + ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files m Project + FindFiles :: FilePath -> [String] -> [FilePath] -> Files m [FilePath] Write :: Destination -> B.Builder -> Files m () @@ -93,10 +91,10 @@ readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File Language readBlobPairs (Left handle) = send (Read (FromPairHandle handle)) readBlobPairs (Right paths) = traverse (send . Read . uncurry FromPathPair) paths -readProject :: Has Files sig m => Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> m Project +readProject :: Has Files sig m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project readProject rootDir dir lang excludeDirs = send (ReadProject rootDir dir lang excludeDirs) -findFiles :: Has Files sig m => Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> m [Path.AbsRelFile] +findFiles :: Has Files sig m => FilePath -> [String] -> [FilePath] -> m [FilePath] findFiles dir exts paths = send (FindFiles dir exts paths) -- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'. diff --git a/semantic/src/Semantic/Util.hs b/semantic/src/Semantic/Util.hs index 6556394414..5c9e0acfeb 100644 --- a/semantic/src/Semantic/Util.hs +++ b/semantic/src/Semantic/Util.hs @@ -25,14 +25,13 @@ import Semantic.Task import qualified Source.Language as Language import Source.Span (Pos (..), point) import System.Exit (die) -import qualified System.Path as Path parseFile, parseFileQuiet :: Parser term -> FilePath -> IO term parseFile parser = runTask' . (parse parser <=< readBlob . fileForPath) parseFileQuiet parser = runTaskQuiet . (parse parser <=< readBlob . fileForPath) fileForPath :: FilePath -> File Language.Language -fileForPath (Path.absRel -> p) = File (Reference p (point (Pos 1 1))) (Language.forPath p) +fileForPath p = File (Reference p (point (Pos 1 1))) (Language.forPath p) runTask', runTaskQuiet :: ParseC TaskC a -> IO a runTask' task = runTaskWithOptions debugOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure diff --git a/semantic/test/Data/Language/Spec.hs b/semantic/test/Data/Language/Spec.hs index b1df3bc637..143c63efa5 100644 --- a/semantic/test/Data/Language/Spec.hs +++ b/semantic/test/Data/Language/Spec.hs @@ -1,14 +1,13 @@ module Data.Language.Spec (testTree) where import Source.Language as Language -import qualified System.Path as Path import Test.Tasty import Test.Tasty.HUnit testTree :: TestTree testTree = testGroup "Data.Language" [ testCase "languageForFilePath works for languages with ambiguous lingo extensions" $ do - Language.forPath (Path.relFile "foo.php") @=? PHP - Language.forPath (Path.relFile "foo.md" ) @=? Markdown - Language.forPath (Path.relFile "foo.tsx") @=? TSX + Language.forPath "foo.php" @=? PHP + Language.forPath "foo.md" @=? Markdown + Language.forPath "foo.tsx" @=? TSX ] diff --git a/semantic/test/Examples.hs b/semantic/test/Examples.hs index d218ca6522..5715c9608d 100644 --- a/semantic/test/Examples.hs +++ b/semantic/test/Examples.hs @@ -22,9 +22,7 @@ import Data.Int import qualified Data.Text as Text import Data.Traversable import System.FilePath.Glob -import System.Path (()) -import qualified System.Path as Path -import qualified System.Path.Directory as Path +import System.FilePath import qualified System.Process as Process import qualified System.Path.Fixture as Fixture import qualified Test.Tasty as Tasty @@ -42,12 +40,12 @@ data LanguageExample = LanguageExample { languageName :: String , languageExtension :: String - , languageSkips :: [Path.RelFile] - , languageDirSkips :: [Path.RelDir] + , languageSkips :: [FilePath] + , languageDirSkips :: [FilePath] } deriving (Eq, Show) -le :: String -> String -> [Path.RelFile] -> [Path.RelDir] -> LanguageExample +le :: String -> String -> [FilePath] -> [FilePath] -> LanguageExample le = LanguageExample examples :: [LanguageExample] @@ -59,8 +57,8 @@ examples = -- , le "typescript" "**/*.[jt]sx" tsxSkips mempty ] -goFileSkips :: [Path.RelFile] -goFileSkips = Path.relPath <$> +goFileSkips :: [FilePath] +goFileSkips = [ -- Super slow "go/src/vendor/golang_org/x/text/unicode/norm/tables.go" @@ -83,8 +81,8 @@ goFileSkips = Path.relPath <$> ] -goDirSkips :: [Path.RelDir] -goDirSkips = Path.relDir <$> +goDirSkips :: [FilePath] +goDirSkips = [ "go/src/cmd/compile/internal/ssa" , "go/test/fixedbugs" , "go/test/syntax" @@ -92,11 +90,11 @@ goDirSkips = Path.relDir <$> , "go/test" ] -pythonFileSkips :: [Path.RelFile] +pythonFileSkips :: [FilePath] pythonFileSkips = [] -rubySkips :: [Path.RelFile] -rubySkips = Path.relFile <$> +rubySkips :: [FilePath] +rubySkips = [ -- Doesn't parse b/c of issue with r< , "ruby_spec/language/lambda_spec.rb" ] -tsxSkips :: [Path.RelFile] -tsxSkips = Path.relFile <$> +tsxSkips :: [FilePath] +tsxSkips = [ ] -typescriptSkips :: [Path.RelFile] -typescriptSkips = Path.relFile <$> +typescriptSkips :: [FilePath] +typescriptSkips = [ "npm/node_modules/slide/lib/async-map-ordered.js" , "npm/node_modules/request/node_modules/har-validator/node_modules/ajv/dist/regenerator.min.js" ] -buildExamples :: Fixture.HasFixture => TaskSession -> LanguageExample -> Path.AbsRelDir -> IO Tasty.TestTree +buildExamples :: Fixture.HasFixture => TaskSession -> LanguageExample -> FilePath -> IO Tasty.TestTree buildExamples session lang tsDir = do let fileSkips = fmap (tsDir ) (languageSkips lang) dirSkips = fmap (tsDir ) (languageDirSkips lang) - files <- globDir1 (compile (languageExtension lang)) (Path.toString tsDir) + files <- globDir1 (compile (languageExtension lang)) tsDir when (null files) - (fail ("Nothing in dir " <> Path.toString tsDir)) + (fail ("Nothing in dir " <> tsDir)) - let paths = filter (\x -> Path.takeDirectory x `notElem` dirSkips) . filter (`notElem` fileSkips) $ Path.absRel <$> files + let paths = filter (\x -> takeDirectory x `notElem` dirSkips) . filter (`notElem` fileSkips) $ files trees <- for paths $ \file -> do - pure . HUnit.testCase (Path.toString file) $ do + pure . HUnit.testCase file $ do precise <- runTask session (runParse (parseSymbolsFilePath file)) assertOK "precise" precise pure (Tasty.testGroup (languageName lang) trees) @@ -172,7 +170,7 @@ main = withOptions testOptions $ \ config logger statter -> do #if BAZEL_BUILD rf <- Fixture.create let ?runfiles = rf - let ?project = Path.relDir "semantic" + let ?project = "semantic" #endif let session = TaskSession config "-" False logger statter @@ -188,6 +186,6 @@ parseSymbolsFilePath :: , Has Parse sig m , Has Files sig m ) - => Path.AbsRelFile + => FilePath -> m ParseTreeSymbolResponse parseSymbolsFilePath path = readBlob (File.fromPath path) >>= parseSymbols . pure @[] diff --git a/semantic/test/Integration/Spec.hs b/semantic/test/Integration/Spec.hs index 623ed6287d..159f44a0b0 100644 --- a/semantic/test/Integration/Spec.hs +++ b/semantic/test/Integration/Spec.hs @@ -9,34 +9,33 @@ import System.FilePath.Glob import System.IO.Unsafe import SpecHelpers -import qualified System.Path as Path -import System.Path (()) +import System.FilePath as Path import Test.Tasty import Test.Tasty.Golden -languages :: [Path.RelDir] -languages = fmap Path.relDir ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"] +languages :: [FilePath] +languages = ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"] testTree :: (?session :: TaskSession) => TestTree testTree = testGroup "Integration (golden tests)" $ fmap testsForLanguage languages -testsForLanguage :: (?session :: TaskSession) => Path.RelDir -> TestTree +testsForLanguage :: (?session :: TaskSession) => FilePath -> TestTree testsForLanguage language = do - let dir = Path.relDir "test/fixtures" language Path.relDir "corpus" + let dir = "test/fixtures" language "corpus" let items = unsafePerformIO (examples dir) - localOption (mkTimeout 3000000) $ testGroup (Path.toString language) $ fmap testForExample items + localOption (mkTimeout 3000000) $ testGroup language $ fmap testForExample items {-# NOINLINE testsForLanguage #-} -data Example = ParseExample Path.RelFile Path.RelFile +data Example = ParseExample FilePath FilePath deriving (Eq, Show) testForExample :: (?session :: TaskSession) => Example -> TestTree testForExample (ParseExample file parseOutput) = goldenVsStringDiff - ("parses " <> Path.toString parseOutput) + ("parses " <> parseOutput) (\ref new -> ["git", "diff", ref, new]) - (Path.toString parseOutput) + parseOutput (parseFilePath ?session file >>= either throw (pure . BL.fromStrict)) @@ -51,7 +50,7 @@ testForExample (ParseExample file parseOutput) = -- | -- | example-name.parseA.txt - The expected sexpression parse tree for example-name.A.rb -- | example-name.parseB.txt - The expected sexpression parse tree for example-name.B.rb -examples :: Path.RelDir -> IO [Example] +examples :: FilePath -> IO [Example] examples directory = do as <- globFor "*.A.*" bs <- globFor "*.B.*" @@ -71,17 +70,17 @@ examples directory = do Just out -> f out name : acc Nothing -> acc - lookupNormalized :: Path.RelFile -> [Path.RelFile] -> Path.RelFile + lookupNormalized :: FilePath -> [FilePath] -> FilePath lookupNormalized name xs = fromMaybe - (error ("cannot find " <> Path.toString name <> " make sure .A, .B and exist.")) + (error ("cannot find " <> name <> " make sure .A, .B and exist.")) (lookupNormalized' name xs) - lookupNormalized' :: Path.RelFile -> [Path.RelFile] -> Maybe Path.RelFile + lookupNormalized' :: FilePath -> [FilePath] -> Maybe FilePath lookupNormalized' name = find ((== name) . normalizeName) - globFor :: String -> IO [Path.RelFile] - globFor p = fmap Path.relFile <$> globDir1 (compile p) (Path.toString directory) + globFor :: String -> IO [FilePath] + globFor p = globDir1 (compile p) directory -- | Given a test name like "foo.A.js", return "foo". -normalizeName :: Path.RelFile -> Path.RelFile +normalizeName :: FilePath -> FilePath normalizeName = Path.dropExtension . Path.dropExtension diff --git a/semantic/test/Semantic/CLI/Spec.hs b/semantic/test/Semantic/CLI/Spec.hs index 88b14c5295..63ca1a0f1d 100644 --- a/semantic/test/Semantic/CLI/Spec.hs +++ b/semantic/test/Semantic/CLI/Spec.hs @@ -6,16 +6,16 @@ import Analysis.File import Analysis.Reference import Control.Carrier.Parse.Simple import Control.Carrier.Reader +import Control.Exception import Data.ByteString.Builder -import Control.Exception -import Source.Language import Semantic.Api hiding (Blob, File) import Semantic.Task import Serializing.Format +import Source.Language +import qualified System.Directory as Path +import qualified System.FilePath as Path import System.IO.Unsafe -import qualified System.Path as Path import qualified System.Path.Fixture as Fixture -import qualified System.Path.Directory as Path import SpecHelpers import Test.Tasty @@ -34,31 +34,31 @@ testTree = testGroup "Semantic.CLI" renderDiff :: String -> String -> [String] renderDiff ref new = unsafePerformIO $ do let check p = do - exists <- Path.doesFileExist (Path.absRel p) + exists <- Path.doesFileExist p unless exists (throwIO (userError ("Can't find path " <> p))) check ref check new - useJD <- (Path.hasExtension ".json" (Path.absRel ref) &&) <$> fmap isJust (Path.findExecutable "jd") + useJD <- (Path.takeExtension ref == ".json" &&) <$> fmap isJust (Path.findExecutable "jd") pure $ if useJD then ["jd", "-set", ref, new] else ["diff", ref, new] {-# NOINLINE renderDiff #-} -testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File Language], Path.AbsRelFile) -> TestTree +testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File Language], FilePath) -> TestTree testForParseFixture (format, runParse, files, expected) = goldenVsStringDiff ("parse fixture renders to " <> format) renderDiff - (Path.toString expected) + expected (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse) -parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File Language], Path.AbsRelFile)] +parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File Language], FilePath)] parseFixtures = - [ ("s-expression", parseTermBuilder TermSExpression, path, Path.absRel "semantic/test/fixtures/ruby/corpus/and-or.parseA.txt") - , ("symbols", parseSymbolsBuilder Serializing.Format.JSON, path'', Path.absRel "semantic/test/fixtures/cli/parse-tree.symbols.json") - , ("protobuf symbols", parseSymbolsBuilder Serializing.Format.Proto, path'', Path.absRel "semantic/test/fixtures/cli/parse-tree.symbols.protobuf.bin") + [ ("s-expression", parseTermBuilder TermSExpression, path, "semantic/test/fixtures/ruby/corpus/and-or.parseA.txt") + , ("symbols", parseSymbolsBuilder Serializing.Format.JSON, path, "semantic/test/fixtures/cli/parse-tree.symbols.json") + , ("protobuf symbols", parseSymbolsBuilder Serializing.Format.Proto, path'', "semantic/test/fixtures/cli/parse-tree.symbols.protobuf.bin") ] - where path = [File (Reference (Path.absRel "semantic/test/fixtures/ruby/corpus/and-or.A.rb") lowerBound) Ruby] - path'' = [File (Reference (Path.absRel "semantic/test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound) Ruby] + where path = [File (Reference "semantic/test/fixtures/ruby/corpus/and-or.A.rb" lowerBound) Ruby] + path'' = [File (Reference "semantic/test/fixtures/ruby/corpus/method-declaration.A.rb" lowerBound) Ruby] diff --git a/semantic/test/Semantic/IO/Spec.hs b/semantic/test/Semantic/IO/Spec.hs index 4d85357d51..5f99bfb5cb 100644 --- a/semantic/test/Semantic/IO/Spec.hs +++ b/semantic/test/Semantic/IO/Spec.hs @@ -13,14 +13,13 @@ import Analysis.Reference as Ref import Data.Blob as Blob import Data.Handle import SpecHelpers -import qualified System.Path as Path import qualified System.Path.Fixture as Fixture spec :: Fixture.HasFixture => Spec spec = do #if BAZEL_BUILD rf <- runIO Fixture.create - let ?project = Path.relDir "semantic" + let ?project = "semantic" ?runfiles = rf #endif let blobsFromFilePath path = do @@ -32,14 +31,14 @@ spec = do it "returns a blob for extant files" $ do let path = Fixture.absRelFile "test/fixtures/cli/diff.json" Just blob <- readBlobFromFile (File (Reference path lowerBound) Unknown) - blobFilePath blob `shouldBe` Path.toString path + blobFilePath blob `shouldBe` path it "throws for absent files" $ do - readBlobFromFile (File (Reference (Path.absRel "/dev/doesnotexist") lowerBound) Unknown) `shouldThrow` anyIOException + readBlobFromFile (File (Reference "/dev/doesnotexist" lowerBound) Unknown) `shouldThrow` anyIOException describe "readBlobPairsFromHandle" $ do - let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end" - let b = Blob.fromSource (Path.relFile "method.rb") Ruby "def bar(x); end" + let a = Blob.fromSource "method.rb" Ruby "def foo; end" + let b = Blob.fromSource "method.rb" Ruby "def bar(x); end" it "returns blobs for valid JSON encoded diff input" $ do blobs <- blobsFromFilePath "test/fixtures/cli/diff.json" blobs `shouldBe` [Compare a b] @@ -64,7 +63,7 @@ spec = do it "returns blobs for unsupported language" $ do h <- openFileForReading (Fixture.absRelFile "test/fixtures/cli/diff-unsupported-language.json") blobs <- readBlobPairsFromHandle h - let b' = Blob.fromSource (Path.relFile "test.kt") Unknown "fun main(args: Array) {\nprintln(\"hi\")\n}\n" + let b' = Blob.fromSource "test.kt" Unknown "fun main(args: Array) {\nprintln(\"hi\")\n}\n" blobs `shouldBe` [Insert b'] it "detects language based on filepath for empty language" $ do @@ -87,7 +86,7 @@ spec = do it "returns blobs for valid JSON encoded parse input" $ do h <- openFileForReading (Fixture.absRelFile "test/fixtures/cli/parse.json") blobs <- readBlobsFromHandle h - let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end" + let a = Blob.fromSource "method.rb" Ruby "def foo; end" blobs `shouldBe` [a] it "throws on blank input" $ do diff --git a/semantic/test/Semantic/Spec.hs b/semantic/test/Semantic/Spec.hs index 318b23518b..a5b35341f9 100644 --- a/semantic/test/Semantic/Spec.hs +++ b/semantic/test/Semantic/Spec.hs @@ -5,7 +5,6 @@ import Analysis.File import Control.Exception (fromException) import qualified Data.Blob as Blob import SpecHelpers -import qualified System.Path as Path import Semantic.Api hiding (Blob) @@ -16,12 +15,12 @@ setBlobLanguage lang b = b { blobFile = (blobFile b) { fileBody = lang }} spec :: Spec spec = do describe "parseBlob" $ do - let methodsBlob = Blob.fromSource (Path.relFile "methods.rb") Ruby "def foo\nend\n" + let methodsBlob = Blob.fromSource "methods.rb" Ruby "def foo\nend\n" it "throws if given an unknown language for sexpression output" $ do res <- runTaskWithOptions defaultOptions (runParseWithConfig (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob])) case res of - Left exc -> fromException exc `shouldBe` Just (NoLanguageForBlob $ Path.absRel "methods.rb") + Left exc -> fromException exc `shouldBe` Just (NoLanguageForBlob "methods.rb") Right _bad -> fail "Expected parseTermBuilder to fail for an unknown language" it "renders with the specified renderer" $ do diff --git a/semantic/test/Spec.hs b/semantic/test/Spec.hs index 3fe9a86e85..8f70bcc15f 100644 --- a/semantic/test/Spec.hs +++ b/semantic/test/Spec.hs @@ -12,7 +12,6 @@ import qualified Semantic.Spec import qualified Semantic.CLI.Spec import qualified Semantic.IO.Spec import qualified Semantic.Stat.Spec -import qualified System.Path as Path import qualified System.Path.Fixture as Fixture import Semantic.Config (defaultOptions, optionsLogLevel) import Semantic.Task (withOptions, TaskSession(..)) @@ -55,7 +54,7 @@ main :: IO () main = do runfiles <- Fixture.create let ?runfiles = runfiles - ?project = Path.relDir "semantic" + ?project = "semantic" withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> let ?session = TaskSession config "-" False logger statter diff --git a/semantic/test/SpecHelpers.hs b/semantic/test/SpecHelpers.hs index cf8becd871..6b2ab6fabd 100644 --- a/semantic/test/SpecHelpers.hs +++ b/semantic/test/SpecHelpers.hs @@ -52,7 +52,6 @@ import Source.Source as X (Source) import Source.Span as X hiding (HasSpan (..), end, point, start) import qualified Source.Span import System.Exit (die) -import qualified System.Path as Path import Test.Hspec as X (Spec, SpecWith, around, context, describe, it, parallel, pendingWith, runIO, xit) import Test.Hspec.Expectations as X @@ -63,7 +62,7 @@ runBuilder :: Builder -> ByteString runBuilder = toStrict . toLazyByteString -- | Returns an s-expression parse tree for the specified path. -parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString) +parseFilePath :: TaskSession -> FilePath -> IO (Either SomeException ByteString) parseFilePath session path = do blob <- readBlobFromFile (File.fromPath path) res <- runTask session . runParse (configTreeSitterParseTimeout (config session)) $ parseTermBuilder TermSExpression (toList blob) @@ -73,7 +72,7 @@ runParseWithConfig :: Has (Reader Config) sig m => ParseC m a -> m a runParseWithConfig task = asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task -- | Read two files to a BlobPair. -readFilePathPair :: Path.RelFile -> Path.RelFile -> IO BlobPair +readFilePathPair :: FilePath -> FilePath -> IO BlobPair readFilePathPair p1 p2 = readFilePair (File.fromPath p1) (File.fromPath p2) -- Run a Task and call `die` if it returns an Exception. diff --git a/semantic/test/Tags/Spec.hs b/semantic/test/Tags/Spec.hs index dabf323bb4..6e97589c49 100644 --- a/semantic/test/Tags/Spec.hs +++ b/semantic/test/Tags/Spec.hs @@ -10,7 +10,6 @@ import Proto.Semantic as P import Semantic.Api.Symbols import Source.Loc import SpecHelpers -import qualified System.Path as Path import qualified System.Path.Fixture as Fixture import Tags.Tagging.Precise @@ -92,7 +91,7 @@ spec = do Tag "foo" P.METHOD P.DEFINITION (Range 175 178) (OneIndexedSpan (Span (Pos 18 12) (Pos 18 15))) "def self.foo" (UTF16CodeUnitSpan (Span (Pos 17 11) (Pos 17 14))) ] -parseTestFile :: Foldable t => t P.SyntaxType -> Path.AbsRelFile -> IO [Tag] +parseTestFile :: Foldable t => t P.SyntaxType -> FilePath -> IO [Tag] parseTestFile include path = runTaskOrDie $ readBlob (File.fromPath path) >>= fmap (filter only) . tagsForBlob where only t = null include || (`elem` include) (tagSyntaxType t)