├── .gitignore ├── src └── IdePurescript │ ├── Modules.js │ ├── Regex.purs │ ├── Exec.purs │ ├── QuickFix.purs │ ├── Tokens.purs │ ├── Pursuit.purs │ ├── PscErrors.purs │ ├── Build.purs │ ├── Completion.purs │ ├── PscIde.purs │ ├── PscIdeServer.purs │ └── Modules.purs ├── .travis.yml ├── README.md ├── bower.json └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psc* 6 | /src/.webpack.js 7 | -------------------------------------------------------------------------------- /src/IdePurescript/Modules.js: -------------------------------------------------------------------------------- 1 | // module IdePurescript.Modules 2 | 3 | exports.tmpDir = function() { 4 | return require('os').tmpdir(); 5 | }; 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | dist: trusty 3 | sudo: required 4 | node_js: 6 5 | env: 6 | - PATH=$HOME/purescript:$PATH 7 | install: 8 | - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/v0.11.7/linux64.tar.gz 9 | - tar -xvf $HOME/purescript.tar.gz -C $HOME/ 10 | - chmod a+x $HOME/purescript 11 | - npm install -g bower pulp 12 | script: 13 | - bower install && pulp build 14 | -------------------------------------------------------------------------------- /src/IdePurescript/Regex.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Regex where 2 | 3 | import Prelude 4 | import Data.String.Regex as R 5 | 6 | import Data.Either (Either(..)) 7 | import Data.Maybe (Maybe(..)) 8 | 9 | replace' :: forall a. Either a R.Regex -> String -> String -> String 10 | replace' (Left _) _ s = s 11 | replace' (Right r) t s = R.replace r t s 12 | 13 | match' :: forall a. Either a R.Regex -> String -> Maybe (Array (Maybe String)) 14 | match' (Left _) = const Nothing 15 | match' (Right r) = R.match r 16 | 17 | test' :: forall a. Either a R.Regex -> String -> Boolean 18 | test' (Left _) = const false 19 | test' (Right r) = R.test r 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-ide-purescript-core 2 | 3 | [![Build Status](https://travis-ci.org/nwolverson/purescript-ide-purescript-core.svg?branch=master)](https://travis-ci.org/nwolverson/purescript-ide-purescript-core) 4 | 5 | Common PureScript code for the core implementation of PureScript editor plugins for JavaScript-based editors, 6 | i.e. [atom-ide-purescript](https://github.com/nwolverson/atom-ide-purescript) and 7 | [vscode-ide-purescript](https://github.com/nwolverson/vscode-ide-purescript). 8 | 9 | Makes use of [purescript-psc-ide](https://github.com/kRITZCREEK/purescript-psc-ide) to launch and 10 | connect to `purs ide server`, which provides editor services (based on PureScript compiler API and 11 | particularly compiler "externs" files) supporting completion, type info, search, pursuit, etc. 12 | 13 | Also wraps the PureScript compiler JSON output. 14 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-ide-purescript-core", 3 | "moduleType": [ 4 | "node" 5 | ], 6 | "ignore": [ 7 | "**/.*", 8 | "node_modules", 9 | "bower_components", 10 | "output" 11 | ], 12 | "dependencies": { 13 | "purescript-console": "^3.0.0", 14 | "purescript-maybe": "^3.0.0", 15 | "purescript-either": "^3.0.0", 16 | "purescript-errors": "^3.0.0", 17 | "purescript-arrays": "^4.0.1", 18 | "purescript-aff": "^3.0.0", 19 | "purescript-affjax": "^4.0.0", 20 | "purescript-argonaut": "^3.0.0", 21 | "purescript-strings": "^3.0.0", 22 | "purescript-psc-ide": "^10.1.0", 23 | "purescript-refs": "^3.0.0", 24 | "purescript-nullable": "^3.0.0", 25 | "purescript-node-fs": "^4.0.0", 26 | "purescript-node-child-process": "^4.0.0", 27 | "purescript-node-fs-aff": "^4.0.0", 28 | "purescript-node-process": "^5.0.0", 29 | "purescript-stringutils": "^0.0.6" 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Nicholas Wolverson 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/IdePurescript/Exec.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Exec where 2 | 3 | import Prelude 4 | import Node.Path as Path 5 | import Control.Monad.Aff (Aff) 6 | import Control.Monad.Eff (Eff) 7 | import Control.Monad.Eff.Class (liftEff) 8 | import Data.Either (either, Either(..)) 9 | import Data.Maybe (fromMaybe, maybe, Maybe(..)) 10 | import Data.StrMap (insert) 11 | import Node.Buffer (BUFFER) 12 | import Node.ChildProcess (CHILD_PROCESS) 13 | import Node.FS (FS) 14 | import Node.Process (getEnv, PROCESS, lookupEnv) 15 | import PscIde.Server (findBins', Executable) 16 | 17 | findBins :: forall a eff. Either a String -> String -> Aff (fs :: FS, buffer :: BUFFER, cp :: CHILD_PROCESS, process :: PROCESS | eff) (Array Executable) 18 | findBins pathVar server = do 19 | env <- liftEff getEnv 20 | findBins' 21 | { pathExt: Nothing 22 | , path: either (const Nothing) Just pathVar 23 | , env: either (const Nothing) (Just <<< flip (insert "PATH") env) pathVar 24 | } 25 | server 26 | 27 | getPathVar :: forall eff. Boolean -> String -> Eff (process :: PROCESS | eff) (Either String String) 28 | getPathVar addNpmBin rootDir = do 29 | processPath <- lookupEnv "PATH" 30 | pure $ if addNpmBin 31 | then Right $ addNpmBinPath rootDir processPath 32 | else Left $ fromMaybe "" processPath 33 | 34 | addNpmBinPath :: String -> Maybe String -> String 35 | addNpmBinPath rootDir path = 36 | Path.concat [ rootDir, "node_modules", ".bin" ] <> (maybe "" (Path.delimiter <> _) path) 37 | -------------------------------------------------------------------------------- /src/IdePurescript/QuickFix.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.QuickFix where 2 | 3 | import Prelude 4 | 5 | import Data.String (null) 6 | import Data.String.Regex (regex) 7 | import Data.String.Regex.Flags (global, noFlags) 8 | import IdePurescript.Regex (replace', test') 9 | 10 | -- | Modify suggestion replacement text, removing extraneous newlines 11 | getReplacement :: String -> String -> String 12 | getReplacement replacement extraText = 13 | let trailingNewline = test' (regex "\n\\s+$" noFlags) replacement 14 | addNewline = trailingNewline && (not $ null extraText) 15 | in 16 | replace' (regex "\\s+\n" global) "\n" replacement 17 | 18 | -- | Get a title which explains what applying a compiler suggestion will do 19 | getTitle :: String -> String 20 | getTitle code = case code of 21 | "UnusedImport" -> "Remove import" 22 | "RedundantEmptyHidingImport" -> "Remove import" 23 | "DuplicateImport" -> "Remove import" 24 | "RedundantUnqualifiedImport" -> "Remove import" 25 | "DeprecatedQualifiedSyntax" -> "Remove qualified keyword" 26 | "ImplicitImport" -> "Make import explicit" 27 | "UnusedExplicitImport" -> "Remove unused references" 28 | _ -> "Apply Suggestion" 29 | 30 | -- | Determine whether an error code represents an unknown token (unknown identifier or missing import) 31 | isUnknownToken :: String -> Boolean 32 | isUnknownToken code = case code of 33 | "UnknownValue" -> true 34 | "UnknownType" -> true 35 | "UnknownDataConstructor" -> true 36 | "UnknownTypeConstructor" -> true 37 | -- In later compiler versions UnknownName covers all of the above 38 | "UnknownName" -> true 39 | _ -> false 40 | -------------------------------------------------------------------------------- /src/IdePurescript/Tokens.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Tokens where 2 | 3 | import Data.Either 4 | import Data.Maybe (Maybe(..)) 5 | import Data.String (length, take, drop) 6 | import Data.String.Regex (Regex, match, regex) 7 | import Data.String.Regex.Flags (noFlags) 8 | import Prelude (const, (<>), (-), (+)) 9 | 10 | type WordRange = { left :: Int, right :: Int } 11 | 12 | modulePart :: String 13 | modulePart = """((?:[A-Z][A-Za-z0-9]*\.)*(?:[A-Z][A-Za-z0-9]*))""" 14 | 15 | identPart :: String 16 | identPart = "((?:[a-zA-Z_][a-zA-Z0-9_']*)|[:!#$%&*+\\./<=>?@\\^|~-]+)" 17 | 18 | modulePrefix :: String 19 | modulePrefix = "(?:^|[^A-Za-z_.])(?:" <> modulePart <> """\.)""" 20 | 21 | moduleRegex :: Either String Regex 22 | moduleRegex = regex (modulePrefix <> "?" <> identPart <> "?$") noFlags 23 | 24 | identifierAtPoint :: String -> Int -> Maybe { word :: String, range :: WordRange, qualifier :: Maybe String } 25 | identifierAtPoint line column = 26 | let beforeRegex = regex "[a-zA-Z_0-9':!#$%&*+/<=>?@^|~-]*$" noFlags 27 | afterRegex = regex "^[a-zA-Z_0-9':!#$%&*+/<=>?@^|~-]*" noFlags 28 | moduleEndRegex = regex (modulePrefix <> "$") noFlags 29 | textBefore = take column line 30 | textAfter = drop column line 31 | wordRange left right = { left: column - left, right: column + right } 32 | match' r t = either (const Nothing) (\r' -> match r' t) r 33 | in 34 | case match' beforeRegex textBefore, match' afterRegex textAfter of 35 | Just [Just s], Just [Just s'] -> 36 | let qualifier = case match' moduleEndRegex (take (length textBefore - length s) textBefore) of 37 | Just [ _, mm ] -> mm 38 | _ -> Nothing 39 | in 40 | Just { word : s<>s', range : wordRange (length s) (length s'), qualifier } 41 | _, _ -> Nothing 42 | -------------------------------------------------------------------------------- /src/IdePurescript/Pursuit.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Pursuit where 2 | 3 | import Prelude 4 | 5 | import Control.Error.Util (hush) 6 | import Control.Monad.Aff (Aff) 7 | import Data.Argonaut (class DecodeJson, Json, decodeJson, (.?)) 8 | import Data.Argonaut.Decode ((.??)) 9 | import Data.Array (filter) 10 | import Data.Either (either) 11 | import Data.Maybe (Maybe) 12 | import Data.MediaType.Common (applicationJSON) 13 | import Network.HTTP.Affjax (AJAX, Affjax, affjax, defaultRequest) 14 | import Network.HTTP.RequestHeader (RequestHeader(..)) 15 | 16 | newtype PursuitSearchInfo = PursuitSearchInfo 17 | { typeOrValue :: Maybe String 18 | , mod :: Maybe String 19 | , typeText :: Maybe String 20 | , title :: Maybe String 21 | , typ :: String 22 | } 23 | 24 | instance decodeJsonPursuitSearchInfo :: DecodeJson PursuitSearchInfo where 25 | decodeJson json = 26 | do 27 | obj <- decodeJson json 28 | typeOrValue <- obj .?? "typeOrValue" 29 | mod <- obj .?? "module" 30 | typeText <- pure $ hush $ obj .? "typeText" 31 | title <- obj .?? "title" 32 | typ <- obj .? "type" 33 | pure $ PursuitSearchInfo { typeOrValue, mod, typeText, title, typ } 34 | 35 | newtype PursuitSearchResult = PursuitSearchResult 36 | { text :: String 37 | , markup :: String 38 | , url :: String 39 | , version :: String 40 | , package :: String 41 | , info :: PursuitSearchInfo 42 | } 43 | 44 | instance decodeJsonPursuitSearchResult :: DecodeJson PursuitSearchResult where 45 | decodeJson json = 46 | do 47 | obj <- decodeJson json 48 | text <- obj .? "text" 49 | markup <- obj .? "markup" 50 | url <- obj .? "url" 51 | version <- obj .? "version" 52 | package <- obj .? "package" 53 | info <- obj .? "info" 54 | pure $ PursuitSearchResult { text, markup, url, version, package, info } 55 | 56 | pursuitRequest :: forall e a. String -> Affjax e Json 57 | pursuitRequest text = affjax $ defaultRequest 58 | { url = "https://pursuit.purescript.org/search?q=" <> text 59 | , headers = [ Accept applicationJSON ] 60 | } 61 | 62 | pursuitSearchRequest :: forall eff. String -> Aff ( ajax :: AJAX | eff ) (Array PursuitSearchResult) 63 | pursuitSearchRequest text = do 64 | res <- pursuitRequest text 65 | let decoded = decodeJson res.response 66 | pure $ either (pure []) id $ decoded 67 | 68 | pursuitModuleSearchRequest :: forall eff. String -> Aff ( ajax :: AJAX | eff ) (Array PursuitSearchResult) 69 | pursuitModuleSearchRequest text = do 70 | res <- pursuitRequest text 71 | let decoded = decodeJson res.response 72 | results = either (pure []) id $ decoded 73 | pure $ filter isModule results 74 | 75 | where 76 | isModule (PursuitSearchResult { info: PursuitSearchInfo { typ: "module" } }) = true 77 | isModule _ = false 78 | -------------------------------------------------------------------------------- /src/IdePurescript/PscErrors.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.PscErrors where 2 | 3 | import Prelude 4 | import Control.Alt ((<|>)) 5 | import Data.Argonaut (decodeJson, class DecodeJson) 6 | import Data.Argonaut.Core (JObject, toObject) 7 | import Data.Argonaut.Decode.Combinators ((.?)) 8 | import Data.Argonaut.Parser (jsonParser) 9 | import Data.Array (singleton) 10 | import Data.Either (either, Either(Left)) 11 | import Data.Maybe (Maybe(Just, Nothing), maybe) 12 | import Data.Newtype (class Newtype) 13 | import Data.Traversable (traverse) 14 | 15 | type ErrorCode = String 16 | type ModuleName = String 17 | type Filename = String 18 | type Lines = Array String 19 | 20 | data RebuildResult = RebuildResult (Array PscError) | RebuildError String 21 | 22 | type PscResult = 23 | { warnings :: Array PscError 24 | , errors :: Array PscError 25 | } 26 | 27 | newtype PscError = PscError 28 | { moduleName :: Maybe ModuleName 29 | , errorCode :: ErrorCode 30 | , message :: String 31 | , filename :: Maybe Filename 32 | , position :: Maybe Position 33 | , errorLink :: String 34 | , suggestion :: Maybe PscSuggestion 35 | } 36 | 37 | derive instance pscErrorNewtype :: Newtype PscError _ 38 | 39 | type PscSuggestion = 40 | { replacement :: String 41 | , replaceRange :: Maybe Position 42 | } 43 | 44 | type Position = 45 | { startLine :: Int 46 | , startColumn :: Int 47 | , endLine :: Int 48 | , endColumn :: Int 49 | } 50 | 51 | instance decodeRebuildResult :: DecodeJson RebuildResult where 52 | decodeJson json = (RebuildResult <$> (decodeJson json <|> (singleton <$> decodeJson json))) 53 | <|> (RebuildError <$> decodeJson json) 54 | 55 | instance decodeJsonPscError :: DecodeJson PscError where 56 | decodeJson json = decodeJson json >>= parsePscError 57 | 58 | parsePscOutput :: String -> Either String PscResult 59 | parsePscOutput = maybe (Left "not object") parsePscResult <<< toObject <=< jsonParser 60 | 61 | parsePscResult :: JObject -> Either String PscResult 62 | parsePscResult obj = 63 | { warnings: _ 64 | , errors: _ 65 | } <$> (obj .? "warnings" >>= traverse parsePscError) 66 | <*> (obj .? "errors" >>= traverse parsePscError) 67 | 68 | parsePscError :: JObject -> Either String PscError 69 | parsePscError obj = PscError <$> ( 70 | { moduleName: _ 71 | , errorCode: _ 72 | , message: _ 73 | , filename: _ 74 | , position: _ 75 | , errorLink: _ 76 | , suggestion: _ 77 | } <$> obj .? "moduleName" 78 | <*> obj .? "errorCode" 79 | <*> obj .? "message" 80 | <*> obj .? "filename" 81 | <*> (obj .? "position" >>= parsePosition) 82 | <*> obj .? "errorLink" 83 | <*> (obj .? "suggestion" >>= parseSuggestion)) 84 | 85 | parsePosition :: Maybe JObject -> Either String (Maybe Position) 86 | parsePosition = 87 | maybe (pure Nothing) \obj -> map Just $ 88 | { startLine: _ 89 | , startColumn: _ 90 | , endLine: _ 91 | , endColumn: _ 92 | } <$> obj .? "startLine" 93 | <*> obj .? "startColumn" 94 | <*> obj .? "endLine" 95 | <*> obj .? "endColumn" 96 | 97 | parseSuggestion :: Maybe JObject -> Either String (Maybe PscSuggestion) 98 | parseSuggestion = 99 | maybe (pure Nothing) \obj -> do 100 | replacement <- obj .? "replacement" 101 | replaceRange <- pure $ either (const Nothing) id (obj .? "replaceRange" >>= parsePosition) 102 | pure $ Just { replacement, replaceRange } 103 | -------------------------------------------------------------------------------- /src/IdePurescript/Build.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Build where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff (Aff, makeAff) 6 | import Control.Monad.Eff (Eff) 7 | import Control.Monad.Eff.Class (liftEff) 8 | import Control.Monad.Eff.Exception (EXCEPTION, error, catchException) 9 | import Control.Monad.Eff.Ref (readRef, REF, modifyRef, newRef) 10 | import Control.Monad.Eff.Unsafe (unsafeCoerceEff) 11 | import Control.Monad.Error.Class (throwError) 12 | import Data.Array (uncons, singleton) 13 | import Data.Bifunctor (bimap) 14 | import Data.Either (either, Either(..)) 15 | import Data.Foldable (find) 16 | import Data.List as List 17 | import Data.Maybe (maybe, Maybe(..)) 18 | import Data.StrMap (fromFoldable) 19 | import Data.String (Pattern(Pattern), split, indexOf) 20 | import Data.Traversable (traverse_) 21 | import Data.Tuple (Tuple(Tuple)) 22 | import IdePurescript.Exec (findBins, getPathVar) 23 | import IdePurescript.PscErrors (PscError(PscError), RebuildResult(RebuildError, RebuildResult), PscResult, parsePscOutput) 24 | import IdePurescript.PscIdeServer (ErrorLevel(..), Notify) 25 | import Node.Buffer (BUFFER) 26 | import Node.ChildProcess (ChildProcess, CHILD_PROCESS) 27 | import Node.ChildProcess as CP 28 | import Node.Encoding (Encoding(UTF8)) 29 | import Node.FS (FS) 30 | import Node.Process (PROCESS) 31 | import Node.Stream as S 32 | import PscIde (NET) 33 | import PscIde as P 34 | import PscIde.Command as PC 35 | import PscIde.Server (Executable(Executable)) 36 | 37 | type BuildOptions = 38 | { command :: Command 39 | , directory :: String 40 | , useNpmDir :: Boolean 41 | } 42 | 43 | data Command = Command String (Array String) 44 | 45 | newtype BuildError = BuildError {} 46 | type BuildResult = 47 | { errors :: PscResult 48 | , success :: Boolean 49 | } 50 | 51 | addExceptionEffect :: forall eff a. Eff eff a -> Eff (exception :: EXCEPTION | eff) a 52 | addExceptionEffect = unsafeCoerceEff 53 | 54 | spawn :: forall eff. BuildOptions 55 | -> Aff (cp :: CHILD_PROCESS, buffer :: BUFFER, fs :: FS, process :: PROCESS | eff) 56 | { cmdBins :: Array Executable, cp :: Maybe ChildProcess } 57 | spawn { command: Command cmd args, directory, useNpmDir } = do 58 | pathVar <- liftEff $ getPathVar useNpmDir directory 59 | cmdBins <- findBins pathVar cmd 60 | cp <- liftEff $ case uncons cmdBins of 61 | Just { head: Executable cmdBin _ } -> Just <$> 62 | CP.spawn cmdBin args (CP.defaultSpawnOptions { cwd = Just directory, env = Just (fromFoldable $ List.singleton $ Tuple "PATH" $ either id id pathVar) }) 63 | _ -> pure Nothing 64 | pure { cmdBins, cp } 65 | 66 | type BuildEff eff = (cp :: CP.CHILD_PROCESS, buffer :: BUFFER, fs :: FS, ref :: REF, process :: PROCESS | eff) 67 | build :: forall eff. Notify (BuildEff eff) -> BuildOptions -> Aff (BuildEff eff) BuildResult 68 | build logCb buildOptions@{ command: Command cmd args, directory, useNpmDir } = do 69 | { cmdBins, cp: cp' } <- spawn buildOptions 70 | makeAff $ \err succ -> do 71 | logCb Info $ "Resolved build command (1st is used): " 72 | traverse_ (\(Executable x vv) -> do 73 | logCb Info $ x <> maybe "" (": " <> _) vv) cmdBins 74 | case cp' of 75 | Nothing -> err $ error $ "Didn't find command in PATH: " <> cmd 76 | Just cp -> do 77 | CP.onError cp (err <<< CP.toStandardError) 78 | let stderr = CP.stderr cp 79 | result <- newRef "" 80 | let res :: String -> Eff (BuildEff (exception :: EXCEPTION | eff)) Unit 81 | res s = do 82 | modifyRef result (\acc -> acc<>s) 83 | 84 | catchException err $ S.onDataString stderr UTF8 res 85 | CP.onClose cp (\exit -> case exit of 86 | CP.Normally n | n == 0 || n == 1 -> do 87 | pscOutput <- readRef result 88 | let lines = split (Pattern "\n") pscOutput 89 | json = find (\s -> indexOf (Pattern "{\"") s == Just 0) lines 90 | case parsePscOutput <$> json of 91 | Just (Left e) -> err $ error e 92 | Just (Right r) -> succ { errors: r, success: n == 0 } 93 | Nothing -> err $ error "Didn't find JSON output" 94 | _ -> err $ error "Process exited abnormally") 95 | 96 | rebuild :: forall eff. Int -> String -> Aff (net :: NET | eff) BuildResult 97 | rebuild port file = do 98 | res <- rebuild' 99 | either 100 | (throwError <<< error) 101 | (pure <<< onResult) 102 | res 103 | where 104 | wrapError :: RebuildResult -> Array PscError 105 | wrapError (RebuildError s) = singleton $ PscError 106 | { moduleName: Nothing 107 | , errorCode: "RebuildStringError" 108 | , message: s 109 | , filename: Just file 110 | , position: Nothing 111 | , errorLink: "" 112 | , suggestion: Nothing 113 | } 114 | wrapError (RebuildResult errs) = errs 115 | 116 | onResult :: Either RebuildResult RebuildResult -> BuildResult 117 | onResult = 118 | either (\errors -> { errors: { errors, warnings: [] }, success: true }) 119 | (\warnings -> { errors: { errors: [], warnings }, success: true }) 120 | <<< 121 | bimap wrapError wrapError 122 | 123 | rebuild' :: P.CmdR RebuildResult RebuildResult 124 | rebuild' = P.sendCommandR port (PC.RebuildCmd file (Just file)) 125 | -------------------------------------------------------------------------------- /src/IdePurescript/Completion.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Completion where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Control.Monad.Aff (Aff) 7 | import Data.Array (filter, head, intersect, sortBy, (:)) 8 | import Data.Either (Either) 9 | import Data.Maybe (Maybe(..), fromMaybe) 10 | import Data.String (Pattern(..), contains, indexOf, length) 11 | import Data.String.Utils (startsWith) 12 | import Data.String.Regex (Regex, regex) 13 | import Data.String.Regex.Flags (noFlags) 14 | import IdePurescript.PscIde (eitherToErr, getCompletion) 15 | import IdePurescript.Regex (match', test') 16 | import IdePurescript.Tokens (identPart, modulePart, moduleRegex) 17 | import PscIde (NET, listAvailableModules) 18 | import PscIde.Command (CompletionOptions(..), ModuleList(..), TypeInfo(..)) 19 | 20 | type ModuleInfo = 21 | { modules :: Array String 22 | , getQualifiedModule :: String -> Array String 23 | , mainModule :: Maybe String 24 | , importedModules :: Array String 25 | } 26 | 27 | data SuggestionType = Module | Type | Function | Value 28 | 29 | explicitImportRegex :: Either String Regex 30 | explicitImportRegex = regex ("""^import\s+""" <> modulePart <> """\s+\([^)]*?""" <> identPart <> "$") noFlags 31 | 32 | getModuleSuggestions :: forall eff. Int -> String -> Aff (net :: NET | eff) (Array String) 33 | getModuleSuggestions port prefix = do 34 | list <- eitherToErr $ listAvailableModules port 35 | pure $ case list of 36 | (ModuleList lst) -> filter (\m -> indexOf (Pattern prefix) m == Just 0) lst 37 | 38 | data SuggestionResult = 39 | ModuleSuggestion { text :: String, suggestType :: SuggestionType, prefix :: String } 40 | | IdentSuggestion { origMod :: String, exportMod :: String, exportedFrom :: Array String, identifier :: String, qualifier :: Maybe String, valueType :: String, suggestType :: SuggestionType, prefix :: String, documentation :: Maybe String } 41 | 42 | getSuggestions :: forall eff. Int -> { 43 | line :: String, 44 | moduleInfo :: ModuleInfo, 45 | groupCompletions :: Boolean, 46 | maxResults :: Maybe Int, 47 | preferredModules :: Array String 48 | } -> Aff (net :: NET | eff) (Array SuggestionResult) 49 | getSuggestions port 50 | { line 51 | , moduleInfo: { modules, getQualifiedModule, mainModule, importedModules } 52 | , maxResults 53 | , groupCompletions 54 | , preferredModules 55 | } = 56 | if moduleExplicit then 57 | case match' explicitImportRegex line of 58 | Just [ Just _, Just mod, Just token ] -> do 59 | completions <- getCompletion port token mainModule Nothing [ mod ] getQualifiedModule opts 60 | pure $ map (result Nothing token) completions 61 | _ -> pure [] 62 | else 63 | case parsed of 64 | Just { mod, token } -> 65 | if moduleCompletion then do 66 | let prefix = getModuleName (fromMaybe "" mod) token 67 | completions <- getModuleSuggestions port prefix 68 | pure $ map (modResult prefix) completions 69 | else do 70 | completions <- getCompletion port token mainModule mod ("Prim":modules) getQualifiedModule opts 71 | pure $ map (result mod token) completions 72 | Nothing -> pure [] 73 | where 74 | opts = CompletionOptions { maxResults, groupReexports: groupCompletions } 75 | 76 | getModuleName "" token = token 77 | getModuleName mod token = mod <> "." <> token 78 | 79 | isImport = indexOf (Pattern "import") line == Just 0 80 | hasBracket = indexOf (Pattern "(") line /= Nothing 81 | moduleCompletion = isImport && not hasBracket 82 | moduleExplicit = isImport && hasBracket 83 | 84 | parsed = case match' moduleRegex line of 85 | Just [ Just _, mod, tok ] | mod /= Nothing || tok /= Nothing -> 86 | Just { mod, token: fromMaybe "" tok} 87 | _ -> Nothing 88 | 89 | modResult prefix moduleName = ModuleSuggestion { text: moduleName, suggestType: Module, prefix } 90 | result qualifier prefix (TypeInfo {type', identifier, module': origMod, exportedFrom, documentation }) = 91 | IdentSuggestion { origMod, exportMod, identifier, qualifier, suggestType, prefix, valueType: type', exportedFrom, documentation } 92 | where 93 | suggestType = 94 | if contains (Pattern "->") type' then Function 95 | else if test' (regex "^[A-Z]" noFlags) identifier then Type 96 | else Value 97 | 98 | -- Strategies for picking the re-export to choose 99 | -- 1. Existing imports 100 | -- 2. User configuration of preferred modules (ordered list) 101 | -- 3. Re-export from a prefix named module (e.g. Foo.Bar.Baz reexported from Foo.Bar) shortest first 102 | -- 4. Original module (if none of the previous rules apply, there are no re-exports, or either grouping 103 | -- is disabled or compiler version does not support it) 104 | exportMod = fromMaybe origMod (existingModule <|> preferredModule <|> prefixModule) 105 | existingModule = head $ intersect importedModules exportedFrom 106 | preferredModule = head $ intersect preferredModules exportedFrom 107 | prefixModule = head $ 108 | sortBy (\a b -> length a `compare` length b) $ 109 | filter (\m -> startsWith (m <> ".") origMod) exportedFrom 110 | -------------------------------------------------------------------------------- /src/IdePurescript/PscIde.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.PscIde (getCompletion, getCompletion', cwd, loadDeps, getType, eitherToErr 2 | , getPursuitModuleCompletion, getPursuitCompletion, getAvailableModules, getLoadedModules, SearchResult, ModuleSearchResult 3 | , getTypeInfo) where 4 | 5 | import Prelude 6 | import Control.Monad.Eff.Exception as Ex 7 | import PscIde as P 8 | import PscIde.Command as C 9 | import Control.Monad.Aff (Aff) 10 | import Control.Monad.Error.Class (throwError) 11 | import Data.Argonaut.Decode (class DecodeJson, decodeJson) 12 | import Data.Argonaut.Decode.Combinators ((.?)) 13 | import Data.Array (head, null) 14 | import Data.Either (Either(Right, Left)) 15 | import Data.Maybe (maybe, Maybe(..)) 16 | import Data.Nullable (toNullable, Nullable) 17 | import Data.String.Regex (regex) 18 | import Data.String.Regex.Flags (global) 19 | import IdePurescript.Regex (replace') 20 | import PscIde.Command (CompletionOptions, TypePosition) 21 | 22 | eitherToErr :: forall a eff. Aff (net :: P.NET | eff) (Either String a) -> (Aff (net :: P.NET | eff) a) 23 | eitherToErr c = do 24 | r <- c 25 | case r of 26 | Left s -> throwError (Ex.error s) 27 | Right res -> pure res 28 | 29 | result :: forall eff a b. (a -> b) -> Aff (net :: P.NET | eff) (Either String a) -> Aff (net :: P.NET | eff) b 30 | result f a = eitherToErr ((f <$> _) <$> a) 31 | 32 | cwd :: forall eff. Int -> Aff (net :: P.NET | eff) String 33 | cwd = result runMsg <<< P.cwd 34 | 35 | runMsg :: C.Message -> String 36 | runMsg (C.Message m) = m 37 | 38 | getImports' :: forall eff. Int -> String 39 | -> Aff (net :: P.NET | eff) (Array { module :: String, qualifier :: Nullable String }) 40 | getImports' port s = result conv $ P.listImports port s 41 | where 42 | conv (C.ImportList { moduleName, imports }) = conv' <$> imports 43 | conv' (C.Import {moduleName, qualifier}) = { 44 | "module": moduleName, 45 | qualifier: toNullable qualifier 46 | } 47 | 48 | getAvailableModules :: forall eff. Int -> Aff (net :: P.NET | eff) (Array String) 49 | getAvailableModules = result conv <<< P.listAvailableModules 50 | where 51 | conv (C.ModuleList modules) = modules 52 | 53 | getLoadedModules :: forall eff. Int -> Aff (net :: P.NET | eff) (Array String) 54 | getLoadedModules = result conv <<< P.listLoadedModules 55 | where 56 | conv (C.ModuleList modules) = modules 57 | 58 | abbrevType :: String -> String 59 | abbrevType = replace' r "$1" 60 | where r = regex """(?:\w+\.)+(\w+)""" $ global 61 | 62 | type TypeResult = {type :: String, identifier :: String, module :: String, position :: Maybe TypePosition} 63 | 64 | getTypeInfo :: forall eff. Int -> String -> Maybe String -> Maybe String -> Array String -> (String -> Array String) 65 | -> Aff (net :: P.NET | eff) (Maybe C.TypeInfo) 66 | getTypeInfo port text currentModule modulePrefix unqualModules getQualifiedModule = 67 | result head $ P.type' port text moduleFilters currentModule 68 | where 69 | moduleFilters = [ C.ModuleFilter $ maybe unqualModules getQualifiedModule modulePrefix ] 70 | 71 | getType :: forall eff. Int -> String -> Maybe String -> Maybe String -> Array String -> (String -> Array String) 72 | -> Aff (net :: P.NET | eff) String 73 | getType port text currentModule modulePrefix unqualModules getQualifiedModule = 74 | maybe "" getType' <$> getTypeInfo port text currentModule modulePrefix unqualModules getQualifiedModule 75 | where 76 | getType' (C.TypeInfo { type' }) = type' 77 | 78 | type CompletionResult = {type :: String, identifier :: String, module :: String} 79 | 80 | getCompletion :: forall eff. Int -> String -> Maybe String -> Maybe String -> Array String -> (String -> Array String) -> CompletionOptions 81 | -> Aff (net :: P.NET | eff) (Array C.TypeInfo) 82 | getCompletion port prefix = 83 | getCompletion' Nothing [C.PrefixFilter prefix] port 84 | 85 | getCompletion' :: forall eff. Maybe C.Matcher -> Array C.Filter -> Int -> Maybe String -> Maybe String -> Array String -> (String -> Array String) -> CompletionOptions 86 | -> Aff (net :: P.NET | eff) (Array C.TypeInfo) 87 | getCompletion' matcher mainFilter port currentModule modulePrefix unqualModules getQualifiedModule opts = 88 | eitherToErr $ P.complete port (mainFilter <> moduleFilters) matcher currentModule opts 89 | where 90 | modules = maybe unqualModules getQualifiedModule modulePrefix 91 | moduleFilters = [ C.ModuleFilter $ if null modules then unqualModules else modules ] 92 | 93 | loadDeps :: forall eff. Int -> String 94 | -> Aff (net :: P.NET | eff) String 95 | loadDeps port main = result runMsg $ P.load port [] [main] 96 | 97 | type SearchResult = { module :: String, package :: String, type:: Maybe String, identifier :: String, text :: String } 98 | 99 | getPursuitCompletion :: forall eff. Int -> String -> Aff (net :: P.NET | eff) (Array SearchResult) 100 | getPursuitCompletion port str = result (map convPursuitCompletion) $ P.pursuitCompletion port str 101 | 102 | convPursuitCompletion :: C.PursuitCompletion -> SearchResult 103 | convPursuitCompletion (C.PursuitCompletion { identifier, type', module', package, text }) 104 | = { identifier, package, type: type', "module": module', text } 105 | 106 | data ModuleCompletion = ModuleCompletion { 107 | module' :: String, 108 | package :: String 109 | } 110 | 111 | instance decodeModuleCompletion :: DecodeJson ModuleCompletion where 112 | decodeJson json = do 113 | o <- decodeJson json 114 | module' <- o .? "module" 115 | package <- o .? "package" 116 | pure (ModuleCompletion { 117 | module': module', 118 | package: package 119 | }) 120 | 121 | type ModuleSearchResult = { module :: String, package :: String } 122 | 123 | getPursuitModuleCompletion :: forall eff. Int -> String 124 | -> Aff (net :: P.NET | eff) (Array ModuleSearchResult) 125 | getPursuitModuleCompletion port str = result (map convPursuitModuleCompletion) $ complete str 126 | where 127 | 128 | complete :: String -> P.Cmd (Array ModuleCompletion) 129 | complete q = P.sendCommand port (C.Pursuit C.Package q) 130 | 131 | convPursuitModuleCompletion :: ModuleCompletion -> ModuleSearchResult 132 | convPursuitModuleCompletion (ModuleCompletion { module', package }) 133 | = { package, "module": module' } 134 | -------------------------------------------------------------------------------- /src/IdePurescript/PscIdeServer.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.PscIdeServer 2 | ( startServer 3 | , startServer' 4 | , stopServer 5 | , ServerStartResult(..) 6 | , ServerEff 7 | , Port 8 | , QuitCallback 9 | , ErrorLevel(..) 10 | , Notify(..) 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Monad.Aff (Aff, attempt, liftEff') 16 | import Control.Monad.Aff.AVar (AVAR) 17 | import Control.Monad.Eff (Eff) 18 | import Control.Monad.Eff.Class (liftEff) 19 | import Control.Monad.Eff.Exception (EXCEPTION) 20 | import Control.Monad.Eff.Random (RANDOM) 21 | import Data.Array (length, head) 22 | import Data.Either (either) 23 | import Data.Int (fromNumber) 24 | import Data.Maybe (Maybe(Just, Nothing), fromMaybe) 25 | import Data.String (Pattern(Pattern), split, toLower) 26 | import Data.Traversable (traverse, traverse_) 27 | import Global (readInt) 28 | import IdePurescript.Exec (getPathVar, findBins) 29 | import IdePurescript.PscIde (cwd) as PscIde 30 | import Node.Buffer (BUFFER) 31 | import Node.ChildProcess (CHILD_PROCESS, ChildProcess, stderr, stdout) 32 | import Node.Encoding (Encoding(..)) 33 | import Node.FS (FS) 34 | import Node.Path (normalize) 35 | import Node.Platform (Platform(..)) 36 | import Node.Process (PROCESS, platform) 37 | import Node.Stream (onDataString) 38 | import PscIde (NET) 39 | import PscIde.Server (Executable(Executable), LogLevel, defaultServerArgs, getSavedPort, pickFreshPort, savePort) 40 | import PscIde.Server as S 41 | 42 | type Port = Int 43 | 44 | data ServerStartResult = 45 | CorrectPath Port 46 | | WrongPath Port String 47 | | Started Port ChildProcess 48 | | Closed 49 | | StartError String 50 | 51 | type ServerEff eff = (cp :: CHILD_PROCESS, process :: PROCESS, net :: NET, avar :: AVAR, fs :: FS, exception :: EXCEPTION, random :: RANDOM, buffer :: BUFFER | eff) 52 | 53 | type QuitCallback eff = (Aff (net :: NET, cp :: CHILD_PROCESS, fs :: FS | eff) Unit) 54 | 55 | data ErrorLevel = Success | Info | Warning | Error 56 | type Notify eff = ErrorLevel -> String -> Eff eff Unit 57 | 58 | data Version = Version Int Int Int 59 | 60 | parseVersion :: String -> Maybe Version 61 | parseVersion s = 62 | case traverse fromNumber $ readInt 10 <$> split (Pattern ".") s of 63 | Just [a, b, c] -> Just $ Version a b c 64 | _ -> Nothing 65 | 66 | instance eqVersion :: Eq Version where 67 | eq (Version a b c) (Version a' b' c') = a == a' && b == b' && c == c' 68 | 69 | instance ordVersion :: Ord Version where 70 | compare (Version a b c) (Version a' b' c') = compare [a,b,c] [a',b',c'] 71 | 72 | instance showVersion :: Show Version where 73 | show (Version a b c) = show a <> "." <> show b <> "." <> show c 74 | 75 | type ServerSettings = 76 | { exe :: String 77 | , combinedExe :: Boolean 78 | , glob :: Array String 79 | , logLevel :: Maybe LogLevel 80 | , editorMode :: Boolean 81 | , polling :: Boolean 82 | , outputDirectory :: Maybe String 83 | } 84 | 85 | -- | Start a psc-ide server instance, or find one already running on the expected port, checking if it has the right path. 86 | -- | Will notify as to what is happening, choose to supply globs appropriately 87 | startServer' :: forall eff eff'. 88 | ServerSettings 89 | -> String 90 | -> Boolean 91 | -> Notify (ServerEff eff) 92 | -> Notify (ServerEff eff) 93 | -> Aff (ServerEff eff) { quit :: QuitCallback eff', port :: Maybe Int } 94 | startServer' settings@({ exe: server, glob }) path addNpmBin cb logCb = do 95 | pathVar <- liftEff $ getPathVar addNpmBin path 96 | serverBins <- findBins pathVar server 97 | case head serverBins of 98 | Nothing -> do 99 | liftEff $ cb Info $ "Couldn't find IDE server, check PATH. Looked for: " 100 | <> server <> " in PATH: " <> either id id pathVar 101 | pure { quit: pure unit, port: Nothing } 102 | Just (Executable bin version) -> do 103 | liftEff $ logCb Info $ "Resolved IDE server paths (npm-bin: " <> show addNpmBin <> ") from PATH of " <> either id id pathVar <> " (1st is used):" 104 | traverse_ (\(Executable x vv) -> 105 | liftEff $ logCb Info $ x <> ": " <> fromMaybe "ERROR" vv) serverBins 106 | liftEff $ when (length serverBins > 1) $ cb Warning $ "Found multiple IDE server executables; using " <> bin 107 | res <- startServer logCb (settings { exe = bin }) path 108 | let noRes = { quit: pure unit, port: Nothing } 109 | liftEff $ case res of 110 | CorrectPath usedPort -> { quit: pure unit, port: Just usedPort } <$ cb Info ("Found existing IDE server with correct path on port " <> show usedPort) 111 | WrongPath usedPort wrongPath -> do 112 | cb Error $ "Found existing IDE server on port '" <> show usedPort <> "' with wrong path: '" <> wrongPath 113 | <> "'. Correct, kill or configure a different port, and restart." 114 | pure noRes 115 | Started usedPort cp -> do 116 | cb Success $ "Started IDE server (port " <> show usedPort <> ")" 117 | wireOutput cp logCb 118 | pure 119 | { quit: stopServer usedPort path cp 120 | , port: Just usedPort 121 | } 122 | Closed -> noRes <$ cb Info "IDE server exited with success code" 123 | StartError err -> noRes <$ (cb Error $ "Could not start IDE server process. Check the configured port number is valid.\n" <> err) 124 | where 125 | wireOutput :: ChildProcess -> Notify (ServerEff eff) -> Eff (ServerEff eff) Unit 126 | wireOutput cp log = do 127 | onDataString (stderr cp) UTF8 (log Warning) 128 | onDataString (stdout cp) UTF8 (log Info) 129 | 130 | -- | Start a psc-ide server instance, or find one already running on the expected port, checking if it has the right path. 131 | startServer :: forall eff. Notify (ServerEff eff) -> ServerSettings -> String -> Aff (ServerEff eff) ServerStartResult 132 | startServer logCb { exe, combinedExe, glob, logLevel, editorMode, polling, outputDirectory } rootPath = do 133 | port <- liftEff $ getSavedPort rootPath 134 | case port of 135 | Just p -> do 136 | workingDir <- attempt $ PscIde.cwd p 137 | liftEff $ logCb Info $ "Found existing port from file: " <> show p <> (either (const "") (", cwd: " <> _) workingDir) 138 | either (const launchServer) (gotPath p) workingDir 139 | Nothing -> launchServer 140 | 141 | where 142 | launchServer = do 143 | newPort <- liftEff pickFreshPort 144 | liftEff $ do 145 | logCb Info $ "Starting IDE server on port " <> show newPort <> " with cwd " <> rootPath 146 | savePort newPort rootPath 147 | r newPort <$> S.startServer (defaultServerArgs 148 | { exe = exe 149 | , combinedExe = combinedExe 150 | , cwd = Just rootPath 151 | , port = Just newPort 152 | , source = glob 153 | , logLevel = logLevel 154 | , editorMode = editorMode 155 | , polling = polling 156 | , outputDirectory = outputDirectory 157 | }) 158 | where 159 | r newPort (S.Started cp) = Started newPort cp 160 | r _ (S.Closed) = Closed 161 | r _ (S.StartError s) = StartError s 162 | 163 | gotPath port workingDir = 164 | liftEff $ if normalizePath workingDir == normalizePath rootPath then 165 | do 166 | logCb Info $ "Found IDE server on port " <> show port <> " with correct path: " <> workingDir 167 | pure $ CorrectPath port 168 | else 169 | do 170 | logCb Info $ "Found IDE server on port " <> show port <> " with wrong path: " <> normalizePath workingDir <> " instead of " <> normalizePath rootPath 171 | pure $ WrongPath port workingDir 172 | 173 | normalizePath = (if platform == Just Win32 then toLower else id) <<< normalize 174 | 175 | -- | Stop a psc-ide server. Currently implemented by asking it nicely, but potentially by killing it if that doesn't work... 176 | stopServer :: forall eff. Int -> String -> ChildProcess -> Aff (cp :: CHILD_PROCESS, net :: NET, fs :: FS | eff) Unit 177 | stopServer port rootPath cp = do 178 | oldPort <- liftEff $ S.getSavedPort rootPath 179 | _ <- liftEff' $ when (oldPort == Just port) $ S.deleteSavedPort rootPath 180 | S.stopServer port 181 | -------------------------------------------------------------------------------- /src/IdePurescript/Modules.purs: -------------------------------------------------------------------------------- 1 | module IdePurescript.Modules ( 2 | Module 3 | , initialModulesState 4 | , State 5 | , getMainModule 6 | , getModuleName 7 | , getModulesForFile 8 | , getModulesForFileTemp 9 | , getUnqualActiveModules 10 | , getAllActiveModules 11 | , getQualModule 12 | , getModuleFromUnknownQualifier 13 | , findImportInsertPos 14 | , addModuleImport 15 | , addExplicitImport 16 | , addQualifiedImport 17 | , ImportResult(..) 18 | ) where 19 | 20 | import Prelude 21 | 22 | import Control.Alt ((<|>)) 23 | import Control.Monad.Aff (Aff, attempt) 24 | import Control.Monad.Eff (Eff) 25 | import Control.Monad.Eff.Class (liftEff) 26 | import Data.Array (findLastIndex, filter, singleton, concatMap, (:)) 27 | import Data.Either (either, Either(..)) 28 | import Data.Foldable (all, notElem, elem) 29 | import Data.Maybe (Maybe(..), maybe, fromMaybe) 30 | import Data.Newtype (class Newtype) 31 | import Data.StrMap as SM 32 | import Data.String (Pattern(Pattern), split) 33 | import Data.String.Regex (regex) as R 34 | import Data.String.Regex.Flags (global, noFlags, multiline) as R 35 | import Data.Tuple (Tuple(..)) 36 | import IdePurescript.Regex (replace', match', test') 37 | import Node.Encoding (Encoding(..)) 38 | import Node.FS (FS) 39 | import Node.FS.Aff as FS 40 | import Node.Path (sep) 41 | import PscIde as P 42 | import PscIde.Command (ImportType(..)) 43 | import PscIde.Command as C 44 | 45 | newtype Module = Module 46 | { moduleName :: String 47 | , importType :: C.ImportType 48 | , qualifier :: Maybe String 49 | } 50 | 51 | derive instance moduleNewtype :: Newtype Module _ 52 | 53 | instance moduleEq :: Eq Module where 54 | eq (Module m1) (Module m2) = 55 | m1.moduleName == m2.moduleName && 56 | m1.qualifier == m2.qualifier && 57 | m1.importType `eqImportType` m2.importType 58 | 59 | eqImportType :: C.ImportType -> C.ImportType -> Boolean 60 | eqImportType Implicit Implicit = true 61 | eqImportType (Explicit idents) (Explicit idents') = idents == idents' 62 | eqImportType (Hiding idents) (Hiding idents') = idents == idents' 63 | eqImportType _ _ = false 64 | 65 | getModuleName :: Module -> String 66 | getModuleName (Module { moduleName }) = moduleName 67 | 68 | type State = 69 | { main :: Maybe String 70 | , modules :: Array Module 71 | , identifiers :: Array String 72 | , identToModule :: SM.StrMap Module 73 | } 74 | 75 | type Path = String 76 | 77 | getMainModule :: String -> Maybe String 78 | getMainModule text = 79 | case match' regex text of 80 | Just [_, Just m] -> Just m 81 | _ -> Nothing 82 | where 83 | regex = R.regex """module\s+([\w.]+)""" $ R.multiline 84 | 85 | getModulesForFile :: forall eff. Int -> Path -> String -> Aff (net :: P.NET | eff) State 86 | getModulesForFile port file fullText = do 87 | C.ImportList { moduleName, imports } <- either (const default) id <$> P.listImports port file 88 | let modules = map mod imports 89 | main = maybe (getMainModule fullText) Just moduleName 90 | identToModule = SM.fromFoldable $ concatMap idents modules 91 | identifiers = SM.keys identToModule 92 | pure { main, modules, identifiers, identToModule } 93 | where 94 | default = C.ImportList { moduleName: Nothing, imports: [] } 95 | mod (C.Import imp) = Module imp 96 | idents m@(Module { importType: Explicit ids }) = flip Tuple m <$> ids 97 | idents _ = [] 98 | 99 | getModulesForFileTemp :: forall eff. Int -> Path -> String -> Aff (net :: P.NET, fs :: FS | eff) State 100 | getModulesForFileTemp port file fullText = do 101 | tmpFile <- makeTempFile file fullText 102 | res <- getModulesForFile port tmpFile fullText 103 | _ <- attempt $ FS.unlink tmpFile 104 | pure res 105 | 106 | mkImplicit :: String -> Module 107 | mkImplicit m = Module { qualifier: Nothing, importType: Implicit, moduleName: m } 108 | 109 | getUnqualActiveModules :: State -> Maybe String -> Array String 110 | getUnqualActiveModules state@{modules, main} ident = getModules include state 111 | where 112 | include (Module { qualifier: Just _ }) = false 113 | include (Module { importType: Explicit idents }) = maybe false (\x -> x `elem` idents || ("(" <> x <> ")") `elem` idents) ident 114 | include (Module { importType: Implicit }) = true 115 | include (Module { importType: Hiding idents }) = maybe true (_ `notElem` idents) ident 116 | 117 | getAllActiveModules :: State -> Array String 118 | getAllActiveModules = getModules (const true) 119 | 120 | getModules :: (Module -> Boolean) -> State -> Array String 121 | getModules include { modules, main } = 122 | ([ "Prim" ] <> _ ) $ map getModuleName $ maybe [] (singleton <<< mkImplicit) main <> filter include modules 123 | 124 | getQualModule :: String -> State -> Array String 125 | getQualModule qualifier {modules} = 126 | map getModuleName $ filter (qual qualifier) modules 127 | where 128 | qual q (Module { qualifier: Just q' }) = q == q' 129 | qual _ _ = false 130 | 131 | getModuleFromUnknownQualifier :: String -> State -> Maybe Module 132 | getModuleFromUnknownQualifier qual { identToModule } = 133 | SM.lookup qual identToModule <|> SM.lookup ("class " <> qual) identToModule 134 | 135 | initialModulesState :: State 136 | initialModulesState = { main: Nothing, modules: [], identifiers: [], identToModule: SM.empty } 137 | 138 | findImportInsertPos :: String -> Int 139 | findImportInsertPos text = 140 | let regex = R.regex """^(module|import) [A-Z][^(]*($|\([^()]*\))""" R.noFlags 141 | lines = split (Pattern "\n") text 142 | res = fromMaybe 0 $ findLastIndex (test' regex) lines 143 | in res+1 144 | 145 | foreign import tmpDir :: forall eff. Eff (fs :: FS | eff) String 146 | 147 | data ImportResult = UpdatedImports String | AmbiguousImport (Array C.TypeInfo) | FailedImport 148 | 149 | makeTempFile :: forall eff. Path -> String -> Aff (fs :: FS | eff) Path 150 | makeTempFile fileName text = do 151 | dir <- liftEff tmpDir 152 | let name = replace' (R.regex "[\\/\\\\:]" R.global) "-" fileName 153 | tmpFile = dir <> sep <> "ide-purescript-" <> name 154 | FS.writeTextFile UTF8 tmpFile text 155 | pure tmpFile 156 | 157 | withTempFile :: forall eff. String -> String -> (String -> Aff (net :: P.NET, fs :: FS | eff) (Either String C.ImportResult)) 158 | -> Aff (net :: P.NET, fs :: FS | eff) ImportResult 159 | withTempFile fileName text action = do 160 | tmpFile <- makeTempFile fileName text 161 | res <- action tmpFile 162 | answer <- case res of 163 | Right (C.SuccessFile _) -> UpdatedImports <$> FS.readTextFile UTF8 tmpFile 164 | Right (C.MultipleResults a) -> pure $ AmbiguousImport a 165 | _ -> pure FailedImport 166 | _ <- attempt $ FS.unlink tmpFile 167 | pure answer 168 | 169 | addModuleImport :: forall eff. State -> Int -> String -> String -> String 170 | -> Aff (net :: P.NET, fs :: FS | eff) (Maybe { state :: State, result :: String }) 171 | addModuleImport state port fileName text moduleName = 172 | case shouldAdd of 173 | false -> pure Nothing 174 | true -> do 175 | res <- withTempFile fileName text addImport 176 | pure $ case res of 177 | UpdatedImports result -> Just { state, result } 178 | _ -> Nothing 179 | where 180 | addImport tmpFile = P.implicitImport port tmpFile (Just tmpFile) [] moduleName 181 | shouldAdd = 182 | state.main /= Just moduleName && (mkImplicit moduleName `notElem` state.modules) 183 | 184 | addExplicitImport :: forall eff. State -> Int -> String -> String -> Maybe String -> Maybe String -> String 185 | -> Aff (net :: P.NET, fs :: FS | eff) { state :: State, result :: ImportResult } 186 | addExplicitImport state port fileName text moduleName qualifier identifier = 187 | case shouldAdd of 188 | false -> pure { state, result: FailedImport } 189 | true -> do 190 | result <- withTempFile fileName text addImport 191 | let state' = case result of 192 | UpdatedImports _ -> state { identifiers = identifier : state.identifiers } 193 | _ -> state 194 | pure { result, state: state' } 195 | where 196 | addImport tmpFile = P.explicitImport port tmpFile (Just tmpFile) filters identifier qualifier 197 | filters = case moduleName of 198 | Nothing -> [] 199 | Just mn -> [C.ModuleFilter [mn]] 200 | isThisModule = case moduleName of 201 | Just _ -> moduleName == state.main 202 | _ -> false 203 | 204 | shouldAdd = not isThisModule 205 | && not (identifier `elem` state.identifiers) 206 | && maybe true (\mn -> all (shouldAddMatch mn) state.modules) moduleName 207 | 208 | shouldAddMatch mn (Module { moduleName: moduleName', qualifier: Nothing, importType: Implicit }) 209 | | moduleName' == mn = false 210 | shouldAddMatch mn (Module { moduleName: moduleName', qualifier: Nothing, importType: Hiding idents }) 211 | | moduleName' == mn = identifier `elem` idents 212 | shouldAddMatch _ _ = true 213 | 214 | addQualifiedImport :: forall eff. State -> Int -> String -> String -> String -> String 215 | -> Aff (net :: P.NET, fs :: FS | eff) { state :: State, result :: ImportResult } 216 | addQualifiedImport state port fileName text moduleName qualifier = 217 | if not isThisModule 218 | then { state, result: _ } <$> withTempFile fileName text addImport 219 | else pure { state, result: FailedImport } 220 | where 221 | addImport tmpFile = P.qualifiedImport port tmpFile (Just tmpFile) moduleName qualifier 222 | isThisModule = Just moduleName == state.main 223 | --------------------------------------------------------------------------------