Merge pull request github#687 from github/pathological,-part-one

Drop pathtype, part one

Author: robrix

.github/workflows/haskell.yml

@@ -66,7 +66,7 @@ jobs:
         cabal v2-run   --project-file=cabal.project.ci semantic-tags:test
         cabal v2-run   --project-file=cabal.project.ci semantic-tsx:test
         cabal v2-run   --project-file=cabal.project.ci semantic-typescript:test
-        cabal v2-run   --project-file=cabal.project.ci semantic-source:test
+        cd semantic-source && cabal v2-run   --project-file=cabal.project.ci semantic-source:test
 
     - name: Write out cache
       run: ./cabal-cache sync-to-archive --threads=2 --archive-uri=dist-cache

cabal.project

@@ -15,7 +15,6 @@ packages: semantic
           semantic-ruby
           semantic-rust
           semantic-scope-graph
-          semantic-source
           semantic-tags
           semantic-tsx
           semantic-typescript

cabal.project.ci

@@ -15,7 +15,6 @@ packages: semantic
           semantic-ruby
           semantic-rust
           semantic-scope-graph
-          semantic-source
           semantic-tags
           semantic-tsx
           semantic-typescript
@@ -54,9 +53,6 @@ package semantic-ruby
 package semantic-scope-graph
   ghc-options: -Werror
 
-package semantic-source
-  ghc-options: -Werror
-
 package semantic-tags
   ghc-options: -Werror
 

semantic-source/CHANGELOG.md

@@ -1,3 +1,9 @@
+# 0.2.0.0
+
+- Finds languages for `FilePath`s.
+- Drops dependency on `pathtype`.
+
+
 # 0.1.0.2
 
 - Support ghc 9.2.

semantic-source/semantic-source.cabal

@@ -1,7 +1,7 @@
 cabal-version:       2.4
 
 name:                semantic-source
-version:             0.1.0.2
+version:             0.2.0.0
 synopsis:            Types and functionality for working with source code
 description:         Types and functionality for working with source code (program text).
 homepage:            https://github.com/github/semantic/tree/master/semantic-source#readme
@@ -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

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,47 +94,47 @@ 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
 
 languageToText :: Language -> T.Text
 languageToText = \case
-  Unknown -> "Unknown"
-  CodeQL -> "CodeQL"
-  Go -> "Go"
-  Haskell -> "Haskell"
-  Java -> "Java"
+  Unknown    -> "Unknown"
+  CodeQL     -> "CodeQL"
+  Go         -> "Go"
+  Haskell    -> "Haskell"
+  Java       -> "Java"
   JavaScript -> "JavaScript"
-  JSON -> "JSON"
-  JSX -> "JSX"
-  Markdown -> "Markdown"
-  PHP -> "PHP"
-  Python -> "Python"
-  Ruby -> "Ruby"
+  JSON       -> "JSON"
+  JSX        -> "JSX"
+  Markdown   -> "Markdown"
+  PHP        -> "PHP"
+  Python     -> "Python"
+  Ruby       -> "Ruby"
   TypeScript -> "TypeScript"
-  TSX -> "TSX"
+  TSX        -> "TSX"
 
 textToLanguage :: T.Text -> Language
 textToLanguage = \case
-  "CodeQL" -> CodeQL
-  "Go" -> Go
-  "Haskell" -> Haskell
-  "Java" -> Java
+  "CodeQL"     -> CodeQL
+  "Go"         -> Go
+  "Haskell"    -> Haskell
+  "Java"       -> Java
   "JavaScript" -> JavaScript
-  "JSON" -> JSON
-  "JSX" -> JSX
-  "Markdown" -> Markdown
-  "PHP" -> PHP
-  "Python" -> Python
-  "Ruby" -> Ruby
+  "JSON"       -> JSON
+  "JSX"        -> JSX
+  "Markdown"   -> Markdown
+  "PHP"        -> PHP
+  "Python"     -> Python
+  "Ruby"       -> Ruby
   "TypeScript" -> TypeScript
-  "TSX" -> TSX
-  _ -> Unknown
+  "TSX"        -> TSX
+  _            -> Unknown