Remove uses of pathtype library.

`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.

Author: patrickt

WORKSPACE

@@ -101,7 +101,6 @@ stack_snapshot(
         "optparse-applicative",
         "optparse-generic",
         "parsers",
-        "pathtype",
         "pretty-show",
         "pretty-simple",
         "prettyprinter",

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",

semantic-analysis/BUILD.bazel

@@ -30,7 +30,6 @@ haskell_library(
         "@stackage//:aeson",
         "@stackage//:fused-effects",
         "@stackage//:hashable",
-        "@stackage//:pathtype",
         "@stackage//:vector",
     ],
 )

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

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

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

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)
 
 

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

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))

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

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",

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

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]

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
 

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

semantic-codeql/test/PreciseTest.hs

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

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

semantic-go/test/PreciseTest.hs

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