Resolve module import paths that walk up directory structure (e.g. ../)

semantic.cabal

@@ -237,6 +237,7 @@ test-suite test
                      , Analysis.Ruby.Spec
                      , Analysis.TypeScript.Spec
                      , Data.Diff.Spec
+                     , Data.Abstract.Path.Spec
                      , Data.Functor.Classes.Generic.Spec
                      , Data.Functor.Listable
                      , Data.Mergeable.Spec

src/Data/Abstract/Path.hs

@@ -3,17 +3,24 @@ module Data.Abstract.Path where
 import Prologue
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
+import System.FilePath.Posix
 
-splitOnPathSeparator :: ByteString -> [ByteString]
-splitOnPathSeparator = BC.split '/'
+-- | Join two paths a and b. Handles walking up relative directories in b. e.g.
+--
+--     joinPaths "a/b" "../c" == "a/c"
+--     joinPaths "a/b" "./c" == "a/b/c"
+--
+-- Walking beyond the beginning of a just stops when you get to the root of a.
+joinPaths :: FilePath -> FilePath -> FilePath
+joinPaths a b = let bs = splitPath (normalise b)
+                    n = length (filter (== "../") bs)
+                in normalise $ walkup n a </> joinPath (drop n bs)
+  where
+    walkup 0 str = str
+    walkup n str = walkup (pred n) (takeDirectory str)
 
 stripQuotes :: ByteString -> ByteString
 stripQuotes = B.filter (`B.notElem` "\'\"")
 
 dropRelativePrefix :: ByteString -> ByteString
 dropRelativePrefix = BC.dropWhile (== '/') . BC.dropWhile (== '.')
-
-dropExtension :: ByteString -> ByteString
-dropExtension path = case BC.split '.' path of
-  [] -> path
-  xs -> BC.intercalate "." (Prelude.init xs)

src/Language/Go/Syntax.hs

@@ -3,6 +3,7 @@ module Language.Go.Syntax where
 
 import Data.Abstract.Evaluatable hiding (Label)
 import Data.Abstract.Module
+import Data.Abstract.Path
 import Data.Abstract.FreeVariables (name)
 import Diffing.Algorithm
 import qualified Data.ByteString.Char8 as BC
@@ -25,7 +26,7 @@ resolveGoImport :: MonadEvaluatable location term value m => FilePath -> m [Modu
 resolveGoImport relImportPath = do
   ModuleInfo{..} <- currentModule
   let relRootDir = takeDirectory (makeRelative moduleRoot modulePath)
-  listModulesInDir $ normalise (relRootDir </> normalise relImportPath)
+  listModulesInDir (joinPaths relRootDir relImportPath)
 
 -- | Import declarations (symbols are added directly to the calling environment).
 --

src/Language/TypeScript/Syntax.hs

@@ -4,6 +4,7 @@ module Language.TypeScript.Syntax where
 import qualified Data.Abstract.Environment as Env
 import qualified Data.Abstract.FreeVariables as FV
 import           Data.Abstract.Evaluatable
+import           Data.Abstract.Path
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
 import           Data.Abstract.Module (ModulePath, ModuleInfo(..))
@@ -45,7 +46,8 @@ resolveRelativePath :: forall value term location m. MonadEvaluatable location t
 resolveRelativePath relImportPath exts = do
   ModuleInfo{..} <- currentModule
   let relRootDir = takeDirectory (makeRelative moduleRoot modulePath)
-  let path = normalise (relRootDir </> normalise relImportPath)
+  let path = joinPaths relRootDir relImportPath
+  traceM $ show relImportPath <> " -> " <> show path
   resolveTSModule path exts >>= either notFound pure
   where
     notFound _ = throwException @(ResolutionError value) $ TypeScriptError relImportPath
@@ -76,7 +78,7 @@ resolveNonRelativePath name exts = do
     notFound _ = throwException @(ResolutionError value) $ TypeScriptError name
 
 resolveTSModule :: MonadEvaluatable location term value m => FilePath -> [String] -> m (Either [FilePath] ModulePath)
-resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths
+resolveTSModule path exts = trace ("typescript (resolve): " <> show path) $ maybe (Left searchPaths) Right <$> resolve searchPaths
   where searchPaths =
           ((path <.>) <$> exts)
           -- TODO: Requires parsing package.json, getting the path of the

test/Data/Abstract/Path/Spec.hs

@@ -0,0 +1,20 @@
+module Data.Abstract.Path.Spec(spec) where
+
+import Data.Abstract.Path
+import SpecHelpers
+
+spec :: Spec
+spec = parallel $
+  describe "joinPaths" $ do
+    it "joins empty paths" $
+      joinPaths "" "" `shouldBe` "."
+    it "joins relative paths" $
+      joinPaths "a/b" "./c" `shouldBe` "a/b/c"
+    it "joins absolute paths" $
+      joinPaths "/a/b" "c" `shouldBe` "/a/b/c"
+    it "walks up directories for ../" $
+      joinPaths "a/b" "../c" `shouldBe` "a/c"
+    it "walks up directories for multiple ../" $
+      joinPaths "a/b" "../../c" `shouldBe` "c"
+    it "stops walking at top directory" $
+      joinPaths "a/b" "../../../c" `shouldBe` "c"

test/Spec.hs

@@ -7,6 +7,7 @@ import qualified Analysis.Ruby.Spec
 import qualified Analysis.TypeScript.Spec
 import qualified Assigning.Assignment.Spec
 import qualified Data.Diff.Spec
+import qualified Data.Abstract.Path.Spec
 import qualified Data.Functor.Classes.Generic.Spec
 import qualified Data.Mergeable.Spec
 import qualified Data.Scientific.Spec
@@ -35,6 +36,7 @@ main = hspec $ do
     describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec
     describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
     describe "Data.Diff" Data.Diff.Spec.spec
+    describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
     describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
     describe "Data.Mergeable" Data.Mergeable.Spec.spec
     describe "Data.Scientific" Data.Scientific.Spec.spec