From b8d050579dc8f421cb4e9719bc633609e452e292 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 15 Jul 2022 15:35:29 -0400 Subject: [PATCH] :fire: pathtype. --- semantic-analysis/semantic-analysis.cabal | 1 - semantic-analysis/src/Analysis/Blob.hs | 24 ++++---- semantic-analysis/src/Analysis/File.hs | 6 +- semantic-analysis/src/Analysis/Module.hs | 4 +- semantic-analysis/src/Analysis/Project.hs | 8 +-- semantic-analysis/src/Analysis/Reference.hs | 8 +-- semantic-analysis/src/Analysis/Syntax.hs | 3 +- semantic-ast/semantic-ast.cabal | 1 - semantic-ast/src/AST/TestHelpers.hs | 60 +++++++++---------- semantic-ast/src/System/Path/Fixture.hs | 17 +++--- semantic-codeql/semantic-codeql.cabal | 1 - semantic-go/semantic-go.cabal | 1 - semantic-java/semantic-java.cabal | 1 - semantic-json/semantic-json.cabal | 1 - semantic-python/semantic-python.cabal | 3 - semantic-ruby/bench/Parsing.hs | 20 +++---- semantic-ruby/semantic-ruby.cabal | 2 - semantic-rust/semantic-rust.cabal | 1 - semantic-scope-graph/src/Data/Module.hs | 9 ++- semantic-tsx/semantic-tsx.cabal | 1 - semantic-typescript/semantic-typescript.cabal | 1 - semantic/semantic.cabal | 4 -- semantic/src/Data/Blob.hs | 23 +++---- semantic/src/Data/Blob/IO.hs | 23 +++---- semantic/src/Data/Handle.hs | 7 +-- semantic/src/Semantic/Api/Bridge.hs | 4 +- semantic/src/Semantic/CLI.hs | 8 +-- semantic/src/Semantic/IO.hs | 10 ++-- semantic/src/Semantic/Task/Files.hs | 14 ++--- semantic/src/Semantic/Util.hs | 4 +- 30 files changed, 109 insertions(+), 161 deletions(-) diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal index 88d7dafaf..0fbf12f91 100644 --- a/semantic-analysis/semantic-analysis.cabal +++ b/semantic-analysis/semantic-analysis.cabal @@ -76,7 +76,6 @@ library , filepath , fused-effects ^>= 1.1 , hashable - , pathtype ^>= 0.8.1 , semantic-source ^>= 0.2 , text ^>= 1.2.3.1 , transformers ^>= 0.5 diff --git a/semantic-analysis/src/Analysis/Blob.hs b/semantic-analysis/src/Analysis/Blob.hs index 1a1015208..5b8ec638f 100644 --- a/semantic-analysis/src/Analysis/Blob.hs +++ b/semantic-analysis/src/Analysis/Blob.hs @@ -8,13 +8,11 @@ module Analysis.Blob , nullBlob ) where -import Analysis.File as A -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 +import Analysis.File as A +import Analysis.Reference as A +import Data.Aeson +import Source.Language as Language +import Source.Source as Source -- | 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 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 4b6cd5725..e6bc8730d 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 body = File (A.Reference (srcLocFile srcLoc) (spanFromSrcLoc srcLoc)) body 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/Module.hs b/semantic-analysis/src/Analysis/Module.hs index 7e15a5037..4a4e294e3 100644 --- a/semantic-analysis/src/Analysis/Module.hs +++ b/semantic-analysis/src/Analysis/Module.hs @@ -13,7 +13,7 @@ import Data.Foldable (foldl') import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as Text -import qualified System.Path as Path +import System.FilePath as Path data Module a = Module { body :: Map.Map Name a -> a @@ -50,7 +50,7 @@ instance Monoid (ModuleSet a) where fromList :: [File (Module a)] -> ModuleSet a fromList = ModuleSet . Map.fromList . map (\ (File ref mod) -> (refName ref, mod)) where - refName (Reference path _) = name (Text.pack (Path.toString (Path.takeBaseName path))) + refName (Reference path _) = name (Text.pack (Path.takeBaseName path)) link :: ModuleSet a -> Module a -> Module a link (ModuleSet ms) m = Module body' (imports m Set.\\ Map.keysSet ms) (exports m) unknown' where diff --git a/semantic-analysis/src/Analysis/Project.hs b/semantic-analysis/src/Analysis/Project.hs index 1b5999873..f8ad53511 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 (takeFileName) -- | 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 . takeFileName . projectRootDir projectExtensions :: Project -> [String] projectExtensions = extensionsForLanguage . projectLanguage diff --git a/semantic-analysis/src/Analysis/Reference.hs b/semantic-analysis/src/Analysis/Reference.hs index 09e2a421e..c79bd8ba0 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) @@ -20,5 +18,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 4f7c8017f..9ffcea23c 100644 --- a/semantic-analysis/src/Analysis/Syntax.hs +++ b/semantic-analysis/src/Analysis/Syntax.hs @@ -55,7 +55,6 @@ import qualified Data.Vector as V import qualified Source.Source as Source import Source.Span import System.FilePath -import qualified System.Path as Path data Term = Var Name @@ -140,7 +139,7 @@ parseFile path = do case (A.eitherDecodeWith A.json' (A.iparse parseGraph) contents) of Left (_, err) -> throwError err Right (_, Nothing) -> throwError "no root node found" - Right (_, Just root) -> pure (sourceContents, File (Reference (Path.absRel sourcePath) span) root) + Right (_, Just root) -> pure (sourceContents, File (Reference sourcePath span) root) where decrSpan (Span (Pos sl sc) (Pos el ec)) = Span (Pos (sl - 1) (sc - 1)) (Pos (el - 1) (ec - 1)) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 45aa2a2c0..d191d330d 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -73,7 +73,6 @@ library , filepath ^>= 1.4.1 , fused-effects ^>= 1.1 , Glob ^>= 0.10.0 - , pathtype ^>= 0.8.1 , semantic-source ^>= 0.2 , 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 ab28363e0..9f82b8f7e 100644 --- a/semantic-ast/src/AST/TestHelpers.hs +++ b/semantic-ast/src/AST/TestHelpers.hs @@ -7,29 +7,28 @@ module AST.TestHelpers , testCorpus ) where -import Control.Applicative -import Control.Monad -import Data.Attoparsec.ByteString.Char8 -import Data.Attoparsec.ByteString.Char8 as Attoparsec -import Data.ByteString (ByteString, readFile) -import Data.ByteString.Char8 (pack, unpack) -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.FilePath.Glob -import Test.Tasty -import Test.Tasty.HUnit +import Control.Applicative +import Control.Monad +import Data.Attoparsec.ByteString.Char8 +import Data.Attoparsec.ByteString.Char8 as Attoparsec +import Data.ByteString (ByteString, readFile) +import Data.ByteString.Char8 (pack, unpack) +import Data.Either +import Data.Functor +import Prelude hiding (takeWhile) +import System.Directory +import System.Exit (exitFailure) +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: " <> show 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 takeFileName 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 84b04928e..845f5c93e 100644 --- a/semantic-ast/src/System/Path/Fixture.hs +++ b/semantic-ast/src/System/Path/Fixture.hs @@ -13,9 +13,8 @@ where import Control.Concurrent import GHC.Stack +import System.FilePath import System.IO -import qualified System.Path as Path -import System.Path (()) #if BAZEL_BUILD import qualified Bazel.Runfiles as Bazel @@ -29,13 +28,13 @@ type HasFixture = create :: IO Bazel.Runfiles create = Bazel.create -root :: HasFixture => Path.AbsRelDir +root :: HasFixture => FilePath root = Path.absRel (Bazel.rlocation ?runfiles ".") -absRelFile :: (HasFixture) => String -> Path.AbsRelFile +absRelFile :: (HasFixture) => String -> FilePath absRelFile x = Path.toAbsRel (root Path.relDir "semantic" ?project Path.relFile x) -absRelDir :: HasFixture => String -> Path.AbsRelDir +absRelDir :: HasFixture => String -> FilePath absRelDir x = Path.toAbsRel (root Path.relDir "semantic" ?project Path.relDir 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 b4fb7d55d..7f7546f08 100644 --- a/semantic-codeql/semantic-codeql.cabal +++ b/semantic-codeql/semantic-codeql.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-codeql , tasty diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index 302cee6e4..7b1e149cd 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-go , tasty diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index ed79b9a7b..391a2c592 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-java , tasty diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index ff3413867..4940be41d 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -68,7 +68,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-json , tasty diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index bbcf2fd5b..c6848e576 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -84,7 +84,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 @@ -112,7 +111,6 @@ library -- , semantic-python -- -- , semantic-scope-graph -- , bytestring - -- , pathtype -- , tasty -- , tasty-hunit @@ -124,7 +122,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-python , tasty diff --git a/semantic-ruby/bench/Parsing.hs b/semantic-ruby/bench/Parsing.hs index 550329270..0ab269a4a 100644 --- a/semantic-ruby/bench/Parsing.hs +++ b/semantic-ruby/bench/Parsing.hs @@ -1,31 +1,29 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications #-} module Parsing (benchmarks) where +import AST.Unmarshal import Control.Monad import qualified Data.ByteString as B 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 +import System.Exit (die) +import System.FilePath.Glob benchmarks :: Benchmark 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)) + paths <- globDir1 (compile glob) dir + when (null paths) (die $ "No files found in " <> dir) for_ paths $ \ 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 5d87a7f33..26c067cc7 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-ruby , tasty @@ -89,7 +88,6 @@ executable benchmarks , bytestring , gauge ^>= 0.2.5 , Glob - , pathtype ^>= 0.8.1 , semantic-ast , semantic-ruby diff --git a/semantic-rust/semantic-rust.cabal b/semantic-rust/semantic-rust.cabal index f676f469b..3a45789bc 100644 --- a/semantic-rust/semantic-rust.cabal +++ b/semantic-rust/semantic-rust.cabal @@ -70,7 +70,6 @@ test-suite test main-is: Test.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-rust , tasty diff --git a/semantic-scope-graph/src/Data/Module.hs b/semantic-scope-graph/src/Data/Module.hs index 885bc96b6..196eb2945 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-tsx/semantic-tsx.cabal b/semantic-tsx/semantic-tsx.cabal index c4abeebf9..f1a9fd8f8 100644 --- a/semantic-tsx/semantic-tsx.cabal +++ b/semantic-tsx/semantic-tsx.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-tsx , tasty diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index 691dbae7d..fec213abf 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -71,7 +71,6 @@ test-suite test main-is: PreciseTest.hs build-depends: , base - , pathtype ^>= 0.8.1 , semantic-ast , semantic-typescript , tasty diff --git a/semantic/semantic.cabal b/semantic/semantic.cabal index ef6e65c0a..a26013a5b 100644 --- a/semantic/semantic.cabal +++ b/semantic/semantic.cabal @@ -122,7 +122,6 @@ library , network >= 2.8 && < 3.2 , 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 @@ -183,7 +182,6 @@ test-suite test , hspec >= 2.6 && <3 , hspec-expectations ^>= 0.8.2 , network >= 2.8 && < 3.2 - , pathtype ^>= 0.8.1 , semantic , semantic-analysis , semantic-ast @@ -208,7 +206,6 @@ test-suite parse-examples , fused-effects ^>= 1.1 , Glob , lens >= 4.17 && < 5.2 - , pathtype ^>= 0.8.1 , process ^>= 1.6.3.0 , semantic , semantic-analysis ^>= 0 @@ -230,7 +227,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 3565369f7..d2cae089e 100644 --- a/semantic/src/Data/Blob.hs +++ b/semantic/src/Data/Blob.hs @@ -31,12 +31,12 @@ import Data.Aeson import Data.Bifunctor import qualified Data.ByteString.Lazy as BL import Data.Edit +import Data.List (stripPrefix) import Data.Maybe.Exts import Data.Module -import Data.List (stripPrefix) 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,17 @@ 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 + where root = fromMaybe (Path.takeDirectory $ blobPath b) rootDir info = ModuleInfo (dropRelative root (blobPath b)) (languageToText (blobLanguage b)) mempty -dropRelative :: Path.AbsRelDir -> Path.AbsRelFile -> Path.AbsRelFile +dropRelative :: FilePath -> FilePath -> FilePath 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' + Just rs | ra == rb -> foldl (Path.) "." rs Path. bf + _ -> b' + where (ra, as) = splitPath $ Path.normalise a' + (rb, bs) = splitPath $ Path.normalise $ Path.takeDirectory b' bf = Path.takeFileName b' + splitPath p = (Path.isAbsolute p, Path.splitDirectories p) -- | 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 +88,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 584d64d9a..0fa65dcec 100644 --- a/semantic/src/Data/Blob/IO.hs +++ b/semantic/src/Data/Blob/IO.hs @@ -21,25 +21,16 @@ 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 - -- 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 + let rootDir = fromMaybe path maybeRoot paths <- liftIO $ findFilesInDir rootDir exts excludeDirs blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths @@ -51,9 +42,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 +55,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 dab9fc9b2..c4c01932d 100644 --- a/semantic/src/Data/Handle.hs +++ b/semantic/src/Data/Handle.hs @@ -20,11 +20,10 @@ module Data.Handle import Control.Exception (Exception, throw) import Control.Monad.IO.Class import Data.Aeson +import Data.Blob 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 ReadHandle :: IO.Handle -> Handle 'IO.ReadMode @@ -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 d04e02aa3..f80aaf27d 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 dba5d8d20..eec7a957e 100644 --- a/semantic/src/Semantic/CLI.hs +++ b/semantic/src/Semantic/CLI.hs @@ -20,8 +20,6 @@ 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 () @@ -112,10 +110,10 @@ 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 +path :: ReadM FilePath +path = eitherReader Right -pathOption :: Path.PartClass.FileDir fd => Mod OptionFields (Path.AbsRel fd) -> Parser (Path.AbsRel fd) +pathOption :: Mod OptionFields FilePath -> Parser FilePath pathOption = option path options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a diff --git a/semantic/src/Semantic/IO.hs b/semantic/src/Semantic/IO.hs index 5ef24ab7a..07cc4c07b 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 3ce275133..d2b664ec1 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 655639441..adbb335b2 100644 --- a/semantic/src/Semantic/Util.hs +++ b/semantic/src/Semantic/Util.hs @@ -4,7 +4,6 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-} module Semantic.Util ( parseFile @@ -25,14 +24,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