Give the Bazel shim a better name, because we'll use this in Cabal

Author: Patrick Thomson

semantic/BUILD.bazel

@@ -124,7 +124,7 @@ haskell_binary(
 
 haskell_library(
     name = "fixtureshim",
-    srcs = ["test/System/Path/Bazel.hs"],
+    srcs = ["test/System/Path/Fixture.hs"],
     deps = [
         "//:base",
         "@stackage//:bazel-runfiles",
@@ -139,7 +139,7 @@ haskell_test(
         exclude = [
             "test/fixtures/**/*.hs",
             "test/Examples.hs",
-            "test/System/Path/Bazel.hs",
+            "test/System/Path/Fixture.hs",
         ],
     ),
     compiler_flags = STANDARD_GHC_WARNINGS + STANDARD_EXECUTABLE_FLAGS + [

semantic/test/Examples.hs

@@ -28,7 +28,7 @@ import           System.Path ((</>))
 import qualified System.Path as Path
 import qualified System.Path.Directory as Path
 import qualified System.Process as Process
-import qualified System.Path.Bazel as Fixture
+import qualified System.Path.Fixture as Fixture
 import qualified Bazel.Runfiles as Runfiles
 import qualified Test.Tasty as Tasty
 import qualified Test.Tasty.HUnit as HUnit
@@ -131,7 +131,7 @@ typescriptSkips = Path.relFile <$>
   , "npm/node_modules/request/node_modules/har-validator/node_modules/ajv/dist/regenerator.min.js"
   ]
 
-buildExamples :: Fixture.HasBazel => TaskSession -> LanguageExample -> Path.AbsRelDir -> IO Tasty.TestTree
+buildExamples :: Fixture.HasFixture => TaskSession -> LanguageExample -> Path.AbsRelDir -> IO Tasty.TestTree
 buildExamples session lang tsDir = do
   let fileSkips = fmap (tsDir </>) (languageSkips lang)
       dirSkips  = fmap (tsDir </>) (languageDirSkips lang)
@@ -170,6 +170,7 @@ main = withOptions testOptions $ \ config logger statter -> do
 
   rf <- Runfiles.create
   let ?runfiles = rf
+  let ?project = Path.relDir "semantic"
 
   let session = TaskSession config "-" False logger statter
 

semantic/test/Semantic/CLI/Spec.hs

@@ -12,15 +12,15 @@ import           Serializing.Format
 import           System.IO.Unsafe
 import           System.Path ((</>))
 import qualified System.Path as Path
-import qualified System.Path.Bazel as Path
+import qualified System.Path.Fixture as Path
 import qualified System.Path.Directory as Path
 
 import SpecHelpers
 import Test.Tasty
 import Test.Tasty.Golden
 
 -- TODO: Fix this, or throw it out entirely.
-testTree :: Path.HasBazel => TestTree
+testTree :: Path.HasFixture => TestTree
 testTree = testGroup "Semantic.CLI"
   [ testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures
   ]

semantic/test/Spec.hs

@@ -13,14 +13,15 @@ import qualified Semantic.CLI.Spec
 import qualified Semantic.IO.Spec
 import qualified Semantic.Stat.Spec
 import qualified Bazel.Runfiles as Bazel
-import qualified System.Path.Bazel as Path
+import qualified System.Path as Path
+import qualified System.Path.Fixture as Fixture
 import Semantic.Config (defaultOptions, optionsLogLevel)
 import Semantic.Task (withOptions, TaskSession(..))
 import Test.Hspec
 import Test.Tasty as Tasty
 import Test.Tasty.Hspec as Tasty
 
-tests :: (?session :: TaskSession, Path.HasBazel) => [TestTree]
+tests :: (?session :: TaskSession, Fixture.HasFixture) => [TestTree]
 tests =
   [ Data.Language.Spec.testTree
   , Data.Semigroup.App.Spec.testTree
@@ -31,7 +32,7 @@ tests =
 
 -- We can't bring this out of the IO monad until we divest
 -- from hspec, since testSpec operates in IO.
-allTests :: (?session :: TaskSession, Path.HasBazel) => IO TestTree
+allTests :: (?session :: TaskSession, Fixture.HasFixture) => IO TestTree
 allTests = do
   asTastySpecs <- Tasty.testSpecs legacySpecs
   let allSpecs = tests <> asTastySpecs
@@ -43,7 +44,7 @@ allTests = do
 -- documentation: "hspec and tasty serve similar purposes; consider
 -- using one or the other.") Instead, create a new TestTree value
 -- in your spec module and add it to the above 'tests' list.
-legacySpecs :: Path.HasBazel => Spec
+legacySpecs :: Fixture.HasFixture => Spec
 legacySpecs = parallel $ do
   describe "Data.Graph" Data.Graph.Spec.spec
   describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
@@ -58,4 +59,5 @@ main = do
   withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter ->
     let ?session = TaskSession config "-" False logger statter
         ?runfiles = runfiles
+        ?project = Path.relDir "semantic"
     in allTests >>= defaultMain

semantic/test/System/Path/Bazel.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ImplicitParams #-}
+
+module System.Path.Fixture
+  ( absFile,
+    absRelFile,
+    bazelDir,
+    HasFixture,
+    absRelDir,
+  )
+where
+
+import qualified Bazel.Runfiles as Bazel
+import Data.Proxy
+import GHC.Stack
+import GHC.TypeLits
+import qualified System.Path as Path
+
+type HasFixture =
+  ( ?runfiles :: Bazel.Runfiles,
+    ?project :: Path.RelDir,
+    HasCallStack
+  )
+
+absFile :: (HasFixture) => String -> Path.AbsFile
+absFile x = Path.absFile (Bazel.rlocation ?runfiles ("semantic/" <> Path.toString ?project <> x))
+
+absRelFile :: (HasFixture) => String -> Path.AbsRelFile
+absRelFile = Path.toAbsRel . absFile
+
+bazelDir :: HasFixture => String -> Path.AbsDir
+bazelDir x = Path.absDir (Bazel.rlocation ?runfiles ("semantic/" <> Path.toString ?project <> x))
+
+absRelDir :: HasFixture => String -> Path.AbsRelDir
+absRelDir = Path.toAbsRel . bazelDir

semantic/test/System/Path/Fixture.hs

@@ -7,82 +7,82 @@ import Semantic.Api.Symbols
 import Source.Loc
 import SpecHelpers
 import qualified System.Path as Path
-import qualified System.Path.Bazel as Path
+import qualified System.Path.Fixture as Fixture
 import Tags.Tagging.Precise
 
-spec :: Path.HasBazel => Spec
+spec :: Fixture.HasFixture => Spec
 spec = do
   describe "go" $ do
     it "produces tags for functions with docs (TODO)" $
-      parseTestFile [P.FUNCTION] (Path.bazelFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
+      parseTestFile [P.FUNCTION] (Fixture.absFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
         [ Tag "TestFromBits" P.FUNCTION P.DEFINITION (Loc (Range 56 68) (Span (Pos 6 6) (Pos 6 18))) "func TestFromBits(t *testing.T) {" Nothing
         , Tag "Hi" P.FUNCTION P.DEFINITION (Loc (Range 99 101) (Span (Pos 10 6) (Pos 10 8))) "func Hi() {" Nothing ]
 
     it "produces tags for methods" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/go/tags/method.go") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/go/tags/method.go") `shouldReturn`
         [ Tag "CheckAuth" P.METHOD P.DEFINITION (Loc (Range 39 48) (Span (Pos 3 21) (Pos 3 30))) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}" Nothing]
 
     it "produces tags for calls" $
-      parseTestFile [P.CALL] (Path.bazelFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
+      parseTestFile [P.CALL] (Fixture.absFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
         [ Tag "Hi" P.CALL P.REFERENCE (Loc (Range 86 88) (Span (Pos 7 2) (Pos 7 4))) "Hi()" Nothing]
 
   describe "javascript and typescript" $ do
     it "produces tags for functions with docs (TODO)" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn`
         [ Tag "myFunction" P.FUNCTION P.DEFINITION (Loc (Range 31 41) (Span (Pos 2 10) (Pos 2 20))) "function myFunction() {" Nothing ]
 
     it "produces tags for classes" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/typescript/tags/class.ts") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/typescript/tags/class.ts") `shouldReturn`
         [ Tag "FooBar" P.CLASS P.DEFINITION (Loc (Range 6 12) (Span (Pos 1 7) (Pos 1 13))) "class FooBar {}" Nothing ]
 
     it "produces tags for modules" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/typescript/tags/module.ts") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/typescript/tags/module.ts") `shouldReturn`
         [ Tag "APromise" P.MODULE P.DEFINITION (Loc (Range 7 15) (Span (Pos 1 8) (Pos 1 16))) "module APromise { }" Nothing ]
 
   describe "python" $ do
     it "produces tags for functions" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn`
         [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" Nothing
         , Tag "Bar" P.FUNCTION P.DEFINITION (Loc (Range 74 77) (Span (Pos 7 5) (Pos 7 8))) "def Bar():" Nothing
         , Tag "local" P.FUNCTION P.DEFINITION (Loc (Range 89 94) (Span (Pos 8 9) (Pos 8 14))) "def local():" Nothing
         ]
 
     it "produces tags for functions with docs" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn`
         [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ]
 
     it "produces tags for classes" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/python/tags/class.py") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/python/tags/class.py") `shouldReturn`
         [ Tag "Foo" P.CLASS P.DEFINITION (Loc (Range 6 9) (Span (Pos 1 7) (Pos 1 10))) "class Foo:" (Just "\"\"\"The Foo class\"\"\"")
         , Tag "f" P.FUNCTION P.DEFINITION (Loc (Range 43 44) (Span (Pos 3 9) (Pos 3 10))) "def f(self):" (Just "\"\"\"The f method\"\"\"")
         ]
 
     it "produces tags for multi-line functions" $
-      parseTestFile [P.FUNCTION] (Path.bazelFile "test/fixtures/python/tags/multiline.py") `shouldReturn`
+      parseTestFile [P.FUNCTION] (Fixture.absFile "test/fixtures/python/tags/multiline.py") `shouldReturn`
         [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x," Nothing ]
 
   describe "ruby" $ do
     it "produces tags for methods" $
-      parseTestFile [P.METHOD] (Path.bazelFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
+      parseTestFile [P.METHOD] (Fixture.absFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
         [ Tag "foo" P.METHOD P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def foo" Nothing ]
 
     it "produces tags for sends" $
-      parseTestFile [P.CALL] (Path.bazelFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
+      parseTestFile [P.CALL] (Fixture.absFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
         [ Tag "puts" P.CALL P.REFERENCE (Loc (Range 10 14) (Span (Pos 2 3) (Pos 2 7))) "puts \"hi\"" Nothing
         , Tag "bar" P.CALL P.REFERENCE (Loc (Range 24 27) (Span (Pos 3 5) (Pos 3 8))) "a.bar" Nothing
         , Tag "a" P.CALL P.REFERENCE (Loc (Range 22 23) (Span (Pos 3 3) (Pos 3 4))) "a" Nothing
         ]
 
     it "produces tags for methods with docs (TODO)" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn`
         [ Tag "foo" P.METHOD P.DEFINITION (Loc (Range 18 21) (Span (Pos 2 5) (Pos 2 8))) "def foo" Nothing ]
 
     it "correctly tags files containing multibyte UTF-8 characters (TODO)" $
-      parseTestFile [] (Path.bazelFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn`
+      parseTestFile [] (Fixture.absFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn`
         [ Tag "日本語" P.METHOD P.DEFINITION (Loc (Range 20 29) (Span (Pos 2 5) (Pos 2 14))) "def 日本語" Nothing]
 
     it "produces tags for methods and classes with docs (TODO)" $
-      parseTestFile [P.MODULE, P.CLASS, P.METHOD] (Path.bazelFile "test/fixtures/ruby/tags/class_module.rb") `shouldReturn`
+      parseTestFile [P.MODULE, P.CLASS, P.METHOD] (Fixture.absFile "test/fixtures/ruby/tags/class_module.rb") `shouldReturn`
         [ Tag "Foo" P.MODULE P.DEFINITION (Loc (Range 21 24) (Span (Pos 2 8) (Pos 2 11))) "module Foo" Nothing
         , Tag "Bar" P.CLASS P.DEFINITION  (Loc (Range 50 53) (Span (Pos 5 9) (Pos 5 12))) "class Bar" Nothing
         , Tag "baz" P.METHOD P.DEFINITION (Loc (Range 81 84) (Span (Pos 8 9) (Pos 8 12))) "def baz(a)" Nothing