Skip to content

Commit

Permalink
Remove uses of pathtype library.
Browse files Browse the repository at this point in the history
`pathtype` was not a great success for us:

- it did not catch any bugs other than exposing some odd behavior in `readProjectFromPaths`;
- it baffled everyone who hadn't spent hours staring into its API (that is to say, me)
- it used `error` to check string literals, which is... fine, I guess, but doesn't help much in actuality;
- it complicated error reporting and assemblage;
- completely switching away from `FilePath` was not an option, as libraries like `directory-tree` and `Glob` require it;
- its documentation is very poor and difficult to navigate;

Furthermore, `pathtype` doesn't solve the most fundamental problem with the
`FilePath` type currently in `base`: its `String` representation. The only valid
representation for cross-platform file paths is `ByteString`, because Windows
paths can contain unpaired UTF-16 surrogates. Upcoming revisions of the library
are switching it to a `ShortByteString` representation, which is the Right Thing.

I think the lesson learned here is that "parse, don't validate" is not super
practical when the entire world has built around validation of file paths rather
than parsing them. Indeed, true validation of file paths would entail IO
everywhere, as we'd want to check for the existence and validity of a file path.
  • Loading branch information
patrickt committed Apr 14, 2022
1 parent 4cfe7cc commit 5537ca9
Show file tree
Hide file tree
Showing 63 changed files with 216 additions and 301 deletions.
1 change: 0 additions & 1 deletion WORKSPACE
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,6 @@ stack_snapshot(
"optparse-applicative",
"optparse-generic",
"parsers",
"pathtype",
"pretty-show",
"pretty-simple",
"prettyprinter",
Expand Down
2 changes: 0 additions & 2 deletions build/common.bzl
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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",
Expand Down
1 change: 0 additions & 1 deletion semantic-analysis/BUILD.bazel
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,6 @@ haskell_library(
"@stackage//:aeson",
"@stackage//:fused-effects",
"@stackage//:hashable",
"@stackage//:pathtype",
"@stackage//:vector",
],
)
2 changes: 1 addition & 1 deletion semantic-analysis/semantic-analysis.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions semantic-analysis/src/Analysis/Analysis/Concrete.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
14 changes: 6 additions & 8 deletions semantic-analysis/src/Analysis/Blob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
6 changes: 2 additions & 4 deletions semantic-analysis/src/Analysis/File.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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)


Expand Down
8 changes: 4 additions & 4 deletions semantic-analysis/src/Analysis/Project.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 3 additions & 5 deletions semantic-analysis/src/Analysis/Reference.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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))
5 changes: 2 additions & 3 deletions semantic-analysis/src/Analysis/Syntax.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion semantic-ast/BUILD.bazel
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,6 @@ haskell_library(
"@stackage//:fused-effects",
"@stackage//:hedgehog",
"@stackage//:optparse-applicative",
"@stackage//:pathtype",
"@stackage//:pretty-simple",
"@stackage//:tasty",
"@stackage//:tasty-hedgehog",
Expand Down
1 change: 0 additions & 1 deletion semantic-ast/semantic-ast.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
34 changes: 15 additions & 19 deletions semantic-ast/src/AST/TestHelpers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ())
Expand All @@ -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]
Expand Down
25 changes: 12 additions & 13 deletions semantic-ast/src/System/Path/Fixture.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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

Expand Down
1 change: 0 additions & 1 deletion semantic-codeql/semantic-codeql.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,6 @@ test-suite test
main-is: PreciseTest.hs
build-depends:
, base
, pathtype ^>= 0.8.1
, semantic-ast
, semantic-codeql
, tasty
Expand Down
5 changes: 2 additions & 3 deletions semantic-codeql/test/PreciseTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,20 +6,19 @@ 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

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

Expand Down
1 change: 0 additions & 1 deletion semantic-go/semantic-go.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,6 @@ test-suite test
main-is: PreciseTest.hs
build-depends:
, base
, pathtype ^>= 0.8.1
, semantic-ast
, semantic-go
, tasty
Expand Down
5 changes: 2 additions & 3 deletions semantic-go/test/PreciseTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,19 +7,18 @@ 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

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
Expand Down
Loading

0 comments on commit 5537ca9

Please sign in to comment.