{-# LANGUAGE FlexibleContexts, RecordWildCards #-}

module Language.TypeScript.Resolution

( ImportPath (..)

, IsRelative (..)

, importPath

, toName

, resolveWithNodejsStrategy

, resolveModule

, resolveNonRelativePath

, javascriptExtensions

, typescriptExtensions

) where

import qualified Data.Map as Map

import System.FilePath.Posix

import Data.Abstract.BaseError

import Data.Abstract.Evaluatable

import qualified Data.Abstract.Module as M

import Data.Abstract.Package

import Data.Abstract.Path

import Data.ImportPath

import qualified Data.Language as Language

resolveWithNodejsStrategy :: ( Has (Modules address value) sig m

, Has (Reader M.ModuleInfo) sig m

, Has (Reader PackageInfo) sig m

, Has (Reader Span) sig m

, Has (Resumable (BaseError ResolutionError)) sig m

, Has Trace sig m

)

=> ImportPath

-> [String]

-> Evaluator term address value m M.ModulePath

resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath path exts

resolveWithNodejsStrategy (ImportPath path _) exts = resolveRelativePath path exts

-- | Resolve a relative TypeScript import to a known 'ModuleName' or fail.

resolveRelativePath :: ( Has (Modules address value) sig m

, Has (Reader M.ModuleInfo) sig m

, Has (Reader PackageInfo) sig m

, Has (Reader Span) sig m

, Has (Resumable (BaseError ResolutionError)) sig m

, Has Trace sig m

)

=> FilePath

-> [String]

-> Evaluator term address value m M.ModulePath

resolveRelativePath relImportPath exts = do

M.ModuleInfo{..} <- currentModule

let relRootDir = takeDirectory modulePath

let path = joinPaths relRootDir relImportPath

trace ("attempting to resolve (relative) require/import " <> show relImportPath)

resolveModule path exts >>= either notFound (\x -> x <$ traceResolve relImportPath path)

where

notFound xs = throwResolutionError $ NotFoundError relImportPath xs Language.TypeScript

-- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail.

resolveNonRelativePath :: ( Has (Modules address value) sig m

, Has (Reader M.ModuleInfo) sig m

, Has (Reader PackageInfo) sig m

, Has (Reader Span) sig m

, Has (Resumable (BaseError ResolutionError)) sig m

, Has Trace sig m

)

=> FilePath

-> [String]

-> Evaluator term address value m M.ModulePath

resolveNonRelativePath name exts = do

M.ModuleInfo{..} <- currentModule

go "." modulePath mempty

where

nodeModulesPath dir = takeDirectory dir </> "node_modules" </> name

-- Recursively search in a 'node_modules' directory, stepping up a directory each time.

go root path searched = do

trace ("attempting to resolve (non-relative) require/import " <> show name)

res <- resolveModule (nodeModulesPath path) exts

case res of

Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)

| otherwise -> notFound (searched <> xs)

Right m -> m <$ traceResolve name m

notFound xs = throwResolutionError $ NotFoundError name xs Language.TypeScript

-- | Resolve a module name to a ModulePath.

resolveModule :: ( Has (Modules address value) sig m

, Has (Reader PackageInfo) sig m

, Has Trace sig m

)

=> FilePath -- ^ Module path used as directory to search in

-> [String] -- ^ File extensions to look for

-> Evaluator term address value m (Either [FilePath] M.ModulePath)

resolveModule path' exts = do

let path = makeRelative "." path'

PackageInfo{..} <- currentPackage

let packageDotJSON = Map.lookup (path </> "package.json") packageResolutions

let searchPaths = ((path <.>) <$> exts)

<> maybe mempty (:[]) packageDotJSON

<> (((path </> "index") <.>) <$> exts)

trace ("searching in " <> show searchPaths)

maybe (Left searchPaths) Right <$> resolve searchPaths

typescriptExtensions :: [String]

typescriptExtensions = ["ts", "tsx", "d.ts"]

javascriptExtensions :: [String]

javascriptExtensions = ["js"]