Rework typescript imports and implement relative import module resolution

src/Data/Abstract/Path.hs

@@ -1,9 +1,25 @@
 module Data.Abstract.Path where
 
 import Prologue
+import Data.Abstract.FreeVariables
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
 
+data Relative = Relative | NonRelative
+  deriving (Eq, Ord, Show)
+
+data Path = Path { unPath :: FilePath, pathIsRelative :: Relative }
+  deriving (Eq, Ord, Show)
+
+path :: ByteString -> Path
+path str = let path = stripQuotes str in Path (BC.unpack path) (pathType path)
+  where
+    pathType xs | not (B.null xs), BC.head xs == '.' = Relative
+                | otherwise = NonRelative
+
+toName :: Path -> Name
+toName = name . BC.pack . unPath
+
 splitOnPathSeparator :: ByteString -> [ByteString]
 splitOnPathSeparator = BC.split '/'
 

src/Language/TypeScript/Assignment.hs

@@ -35,9 +35,6 @@ type Syntax = '[
   , Declaration.PublicFieldDefinition
   , Declaration.VariableDeclaration
   , Declaration.TypeAlias
-  , Declaration.Import
-  , Declaration.QualifiedImport
-  , Declaration.SideEffectImport
   , Declaration.DefaultExport
   , Declaration.QualifiedExport
   , Declaration.QualifiedExportFrom
@@ -165,6 +162,9 @@ type Syntax = '[
   , TypeScript.Syntax.Update
   , TypeScript.Syntax.ComputedPropertyName
   , TypeScript.Syntax.Decorator
+  , TypeScript.Syntax.Import
+  , TypeScript.Syntax.QualifiedImport
+  , TypeScript.Syntax.SideEffectImport
   , []
   ]
 
@@ -632,13 +632,13 @@ statementIdentifier :: Assignment
 statementIdentifier = makeTerm <$> symbol StatementIdentifier <*> (Syntax.Identifier <$> (name <$> source))
 
 importStatement :: Assignment
-importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> children ((,) <$> importClause <*> term fromClause)
+importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> children ((,) <$> importClause <*> fromClause)
                 <|> makeTerm' <$> symbol Grammar.ImportStatement <*> children (requireImport <|> sideEffectImport)
   where
     -- `import foo = require "./foo"`
-    requireImport = inj <$> (symbol Grammar.ImportRequireClause *> children (flip Declaration.QualifiedImport <$> term identifier <*> term fromClause <*> pure []))
+    requireImport = inj <$> (symbol Grammar.ImportRequireClause *> children (flip TypeScript.Syntax.QualifiedImport <$> term identifier <*> fromClause <*> pure []))
     -- `import "./foo"`
-    sideEffectImport = inj <$> (Declaration.SideEffectImport <$> term fromClause <*> emptyTerm)
+    sideEffectImport = inj <$> (TypeScript.Syntax.SideEffectImport <$> fromClause <*> emptyTerm)
     -- `import { bar } from "./foo"`
     namedImport = (,,,) <$> pure Prelude.False <*> pure Nothing <*> (symbol Grammar.NamedImports *> children (many importSymbol)) <*> emptyTerm
     -- `import defaultMember from "./foo"`
@@ -654,9 +654,9 @@ importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> childr
         <|> ((\a b -> [a, b]) <$> defaultImport <*> (namedImport <|> namespaceImport))
         <|> (pure <$> defaultImport))
 
-    makeImportTerm1 loc from (Prelude.True, Just alias, symbols, _) = makeTerm loc (Declaration.QualifiedImport from alias symbols)
-    makeImportTerm1 loc from (Prelude.True, Nothing, symbols, _) = makeTerm loc (Declaration.QualifiedImport from from symbols)
-    makeImportTerm1 loc from (_, _, symbols, extra) = makeTerm loc (Declaration.Import from symbols extra)
+    makeImportTerm1 loc from (Prelude.True, Just alias, symbols, _) = makeTerm loc (TypeScript.Syntax.QualifiedImport from alias symbols)
+    makeImportTerm1 loc from (Prelude.True, Nothing, symbols, _) = makeTerm loc (TypeScript.Syntax.QualifiedImport from (makeTerm loc (Syntax.Identifier (toName from))) symbols)
+    makeImportTerm1 loc from (_, _, symbols, extra) = makeTerm loc (TypeScript.Syntax.Import from symbols extra)
     makeImportTerm loc ([x], from) = makeImportTerm1 loc from x
     makeImportTerm loc (xs, from) = makeTerm loc $ fmap (makeImportTerm1 loc from) xs
     importSymbol = symbol Grammar.ImportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> ((Just <$> rawIdentifier) <|> pure Nothing))
@@ -664,6 +664,9 @@ importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> childr
     makeNameAliasPair from (Just alias) = (from, alias)
     makeNameAliasPair from Nothing = (from, from)
 
+    -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.
+    fromClause = symbol Grammar.String *> (path <$> source)
+
 fromClause :: Assignment
 fromClause = makeTerm <$> symbol Grammar.String <*> (Syntax.Identifier <$> (toName <$> source))
   where

src/Language/TypeScript/Syntax.hs

@@ -1,9 +1,63 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Language.TypeScript.Syntax where
 
-import Prologue
 import Data.Abstract.Evaluatable
+import Data.Abstract.Path
+import qualified Data.Abstract.Environment as Env
 import Diffing.Algorithm
+import System.FilePath.Posix
+import Prologue
+import Prelude hiding (fail)
+
+data Import a = Import { importFrom :: Path, importSymbols :: ![(Name, Name)], importWildcardToken :: !a }
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
+
+instance Eq1 Import where liftEq = genericLiftEq
+instance Ord1 Import where liftCompare = genericLiftCompare
+instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
+
+  -- http://www.typescriptlang.org/docs/handbook/module-resolution.html
+instance Evaluatable Import where
+  eval (Import (Path _ NonRelative) _ _) = fail "non-relative imports are not implememented"
+  eval (Import (Path path Relative) symbols _) = do
+    currentModuleDir <- takeDirectory <$> currentModuleFilePath
+    let path' = makeRelative currentModuleDir path
+    let dir = takeDirectory path'
+    let searchPaths =  (path' <.>) <$> exts
+                    -- <> [dir </> "package.json"] TODO: Requires parsing package.json and getting the path of the "types" property.
+                    <> (((dir </> "index") <.>) <$> exts)
+    maybeModulePath <- resolve searchPaths
+    case maybeModulePath of
+      Nothing -> fail ("module: " <> show path <> " not found. looked for: " <> show searchPaths)
+      Just modulePath -> do
+        (importedEnv, _) <- isolate (require modulePath)
+        modifyEnv (mappend (renamed importedEnv)) *> unit
+    where
+      exts = ["ts", "tsx", "d.ts"]
+      renamed importedEnv
+        | Prologue.null symbols = importedEnv
+        | otherwise = Env.overwrite symbols importedEnv
+
+
+data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: Path, qualifiedImportAlias :: !a, qualifiedImportSymbols :: ![(Name, Name)]}
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
+
+instance Eq1 QualifiedImport where liftEq = genericLiftEq
+instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
+instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable QualifiedImport
+
+data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: Path, sideEffectImportToken :: !a }
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
+
+instance Eq1 SideEffectImport where liftEq = genericLiftEq
+instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
+instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable SideEffectImport
+
+
 
 -- | Lookup type for a type-level key in a typescript map.
 data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a }