purescript-0.13.0: src/Language/PureScript/Ide/Imports.hs
-----------------------------------------------------------------------------
--
-- Module : Language.PureScript.Ide.Imports
-- Description : Provides functionality to manage imports
-- Copyright : Christoph Hegemann 2016
-- License : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability : experimental
--
-- |
-- Provides functionality to manage imports
-----------------------------------------------------------------------------
module Language.PureScript.Ide.Imports
( addImplicitImport
, addQualifiedImport
, addImportForIdentifier
, answerRequest
, parseImportsFromFile
-- for tests
, parseImport
, prettyPrintImportSection
, addImplicitImport'
, addQualifiedImport'
, addExplicitImport'
, sliceImportSection
, prettyPrintImport'
, Import(Import)
)
where
import Protolude hiding (moduleName)
import Data.List (findIndex, nubBy, partition)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Language.PureScript as P
import qualified Language.PureScript.Constants as C
import qualified Language.PureScript.CST as CST
import Language.PureScript.Ide.Completion
import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.State
import Language.PureScript.Ide.Prim
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
import Lens.Micro.Platform ((^.), (%~), ix, has)
import System.IO.UTF8 (writeUTF8FileT)
data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)
deriving (Eq, Show)
-- | Reads a file and returns the parsed module name as well as the parsed
-- imports, while ignoring eventual parse errors that aren't relevant to the
-- import section
parseImportsFromFile
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (P.ModuleName, [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)])
parseImportsFromFile file = do
(mn, _, imports, _) <- parseImportsFromFile' file
pure (mn, unwrapImport <$> imports)
where
unwrapImport (Import a b c) = (a, b, c)
-- | Reads a file and returns the (lines before the imports, the imports, the
-- lines after the imports)
parseImportsFromFile'
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (P.ModuleName, [Text], [Import], [Text])
parseImportsFromFile' fp = do
(_, file) <- ideReadFile fp
case sliceImportSection (T.lines file) of
Right res -> pure res
Left err -> throwError (GeneralError err)
-- | @ImportParse@ holds the data we extract out of a partial parse of the
-- sourcefile
data ImportParse = ImportParse
{ ipModuleName :: P.ModuleName
-- ^ the module name we parse
, ipStart :: P.SourcePos
-- ^ the beginning of the import section. If `import Prelude` was the first
-- import, this would point at `i`
, ipEnd :: P.SourcePos
-- ^ the end of the import section
, ipImports :: [Import]
-- ^ the extracted import declarations
}
parseModuleHeader :: Text -> Either (NE.NonEmpty CST.ParserError) ImportParse
parseModuleHeader src = do
CST.PartialResult md _ <- CST.parseModule $ CST.lenient $ CST.lex src
let
mn = CST.nameValue $ CST.modNamespace md
decls = flip fmap (CST.modImports md) $ \decl -> do
let ((ss, _), mn', it, qual) = CST.convertImportDecl "<purs-ide>" decl
(ss, Import mn' it qual)
case (head decls, lastMay decls) of
(Just hd, Just ls) -> do
let
ipStart = P.spanStart $ fst hd
ipEnd = P.spanEnd $ fst ls
pure $ ImportParse mn ipStart ipEnd $ snd <$> decls
_ -> do
let pos = CST.sourcePos . CST.srcEnd . CST.tokRange . CST.tokAnn $ CST.modWhere md
pure $ ImportParse mn pos pos []
sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text])
sliceImportSection fileLines = first (toS . CST.prettyPrintError . NE.head) $ do
ImportParse{..} <- parseModuleHeader file
pure
( ipModuleName
, sliceFile (P.SourcePos 1 1) (prevPos ipStart)
, ipImports
-- Not sure why I need to drop 1 here, but it makes the tests pass
, drop 1 (sliceFile (nextPos ipEnd) (P.SourcePos (length fileLines) (lineLength (length fileLines))))
)
where
prevPos (P.SourcePos l c)
| l == 1 && c == 1 = P.SourcePos l c
| c == 1 = P.SourcePos (l - 1) (lineLength (l - 1))
| otherwise = P.SourcePos l (c - 1)
nextPos (P.SourcePos l c)
| c == lineLength l = P.SourcePos (l + 1) 1
| otherwise = P.SourcePos l (c + 1)
file = T.unlines fileLines
lineLength l = T.length (fileLines ^. ix (l - 1))
sliceFile (P.SourcePos l1 c1) (P.SourcePos l2 c2) =
fileLines
& drop (l1 - 1)
& take (l2 - l1 + 1)
& ix 0 %~ T.drop (c1 - 1)
& ix (l2 - l1) %~ T.take c2
-- | Adds an implicit import like @import Prelude@ to a Sourcefile.
addImplicitImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath -- ^ The source file read from
-> P.ModuleName -- ^ The module to import
-> m [Text]
addImplicitImport fp mn = do
(_, pre, imports, post) <- parseImportsFromFile' fp
let newImportSection = addImplicitImport' imports mn
pure $ joinSections (pre, newImportSection, post)
addImplicitImport' :: [Import] -> P.ModuleName -> [Text]
addImplicitImport' imports mn =
prettyPrintImportSection (Import mn P.Implicit Nothing : imports)
-- | Adds a qualified import like @import Data.Map as Map@ to a source file.
addQualifiedImport
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-- ^ The sourcefile read from
-> P.ModuleName
-- ^ The module to import
-> P.ModuleName
-- ^ The qualifier under which to import
-> m [Text]
addQualifiedImport fp mn qualifier = do
(_, pre, imports, post) <- parseImportsFromFile' fp
let newImportSection = addQualifiedImport' imports mn qualifier
pure $ joinSections (pre, newImportSection, post)
addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text]
addQualifiedImport' imports mn qualifier =
prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports)
-- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an
-- explicit import already exists for the given module, it adds the identifier
-- to that imports list.
--
-- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing
-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude
-- (bind, unit)"]@
addExplicitImport :: (MonadIO m, MonadError IdeError m) =>
FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]
addExplicitImport fp decl moduleName qualifier = do
(mn, pre, imports, post) <- parseImportsFromFile' fp
let newImportSection =
-- TODO: Open an issue when this PR is merged, we should optimise this
-- so that this case does not write to disc
if mn == moduleName
then imports
else addExplicitImport' decl moduleName qualifier imports
pure $ joinSections (pre, prettyPrintImportSection newImportSection, post)
addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import]
addExplicitImport' decl moduleName qualifier imports =
let
isImplicitlyImported =
any (\case
Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier'
_ -> False) imports
isNotExplicitlyImportedFromPrim =
moduleName == C.Prim &&
not (any (\case
Import C.Prim (P.Explicit _) Nothing -> True
_ -> False) imports)
-- We can't import Modules from other modules
isModule = has _IdeDeclModule decl
matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier'
matches _ = False
freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier
in
if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule
then imports
else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports
where
refFromDeclaration (IdeDeclTypeClass tc) =
P.TypeClassRef ideSpan (tc ^. ideTCName)
refFromDeclaration (IdeDeclDataConstructor dtor) =
P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing
refFromDeclaration (IdeDeclType t) =
P.TypeRef ideSpan (t ^. ideTypeName) (Just [])
refFromDeclaration (IdeDeclValueOperator op) =
P.ValueOpRef ideSpan (op ^. ideValueOpName)
refFromDeclaration (IdeDeclTypeOperator op) =
P.TypeOpRef ideSpan (op ^. ideTypeOpName)
refFromDeclaration (IdeDeclKind kn) =
P.KindRef ideSpan kn
refFromDeclaration d =
P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d))
-- | Adds a declaration to an import:
-- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)
insertDeclIntoImport :: IdeDeclaration -> Import -> Import
insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =
Import mn (P.Explicit (sortBy P.compDecRef (insertDeclIntoRefs decl' refs))) qual
insertDeclIntoImport _ is = is
insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]
insertDeclIntoRefs d@(IdeDeclDataConstructor dtor) refs =
updateAtFirstOrPrepend
(matchType (dtor ^. ideDtorTypeName))
(insertDtor (dtor ^. ideDtorName))
(refFromDeclaration d)
refs
insertDeclIntoRefs (IdeDeclType t) refs
| any matches refs = refs
where
matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName
matches _ = False
insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)
insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing
insertDtor _ refs = refs
matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool
matchType tn (P.TypeRef _ n _) = tn == n
matchType _ _ = False
ideSpan :: P.SourceSpan
ideSpan = P.internalModuleSourceSpan "<psc-ide>"
updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
updateAtFirstOrPrepend p t d l =
case findIndex p l of
Nothing -> d : l
Just i ->
let (x, a : y) = splitAt i l
in x ++ [t a] ++ y
-- | Looks up the given identifier in the currently loaded modules.
--
-- * Throws an error if the identifier cannot be found.
--
-- * If exactly one match is found, adds an explicit import to the importsection
--
-- * If more than one possible imports are found, reports the possibilities as a
-- list of completions.
addImportForIdentifier
:: (Ide m, MonadError IdeError m)
=> FilePath -- ^ The Sourcefile to read from
-> Text -- ^ The identifier to import
-> Maybe P.ModuleName -- ^ The optional qualifier under which to import
-> [Filter] -- ^ Filters to apply before searching for the identifier
-> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier fp ident qual filters = do
let addPrim = Map.union idePrimDeclarations
modules <- getAllModules Nothing
let
matches =
getExactMatches ident filters (addPrim modules)
& map (fmap discardAnn)
& filter (\(Match (_, d)) -> not (has _IdeDeclModule d))
case matches of
[] ->
throwError (NotFound "Couldn't find the given identifier. \
\Have you loaded the corresponding module?")
-- Only one match was found for the given identifier, so we can insert it
-- right away
[Match (m, decl)] ->
Right <$> addExplicitImport fp decl m qual
-- This case comes up for newtypes and dataconstructors. Because values and
-- types don't share a namespace we can get multiple matches from the same
-- module. This also happens for parameterized types, as these generate both
-- a type aswell as a type synonym.
ms@[Match (m1, d1), Match (m2, d2)] ->
if m1 /= m2
-- If the modules don't line up we just ask the user to specify the
-- module
then pure (Left ms)
else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of
-- If dataconstructor and type line up we just import the
-- dataconstructor as that will give us an unnecessary import warning at
-- worst
Just decl ->
Right <$> addExplicitImport fp decl m1 qual
-- Here we need the user to specify whether he wanted a dataconstructor
-- or a type
-- TODO: With the new namespace filter, this can actually be a
-- request for the user to specify which of the two was wanted.
Nothing ->
throwError (GeneralError "Undecidable between type and dataconstructor")
-- Multiple matches were found so we need to ask the user to clarify which
-- module he meant
xs ->
pure (Left xs)
where
decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) =
if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing
decideRedundantCase IdeDeclType{} ts@IdeDeclTypeSynonym{} =
Just ts
decideRedundantCase _ _ = Nothing
prettyPrintImport' :: Import -> Text
prettyPrintImport' (Import mn idt qual) =
"import " <> P.prettyPrintImport mn idt qual
prettyPrintImportSection :: [Import] -> [Text]
prettyPrintImportSection imports =
let
(implicitImports, explicitImports) = partition isImplicitImport imports
in
sort (map prettyPrintImport' implicitImports)
-- Only add the extra spacing if both implicit as well as
-- explicit/qualified imports exist
<> (guard (not (null explicitImports || null implicitImports)) $> "")
<> sort (map prettyPrintImport' explicitImports)
where
isImplicitImport :: Import -> Bool
isImplicitImport i = case i of
Import _ P.Implicit Nothing -> True
Import _ (P.Hiding _) Nothing -> True
_ -> False
-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,
-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the
-- first argument.
answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success
answerRequest outfp rs =
case outfp of
Nothing -> pure (MultilineTextResult rs)
Just outfp' -> do
liftIO (writeUTF8FileT outfp' (T.unlines rs))
pure (TextResult ("Written to " <> T.pack outfp'))
-- | Test and ghci helper
parseImport :: Text -> Maybe Import
parseImport t =
case fmap (CST.convertImportDecl "<purs-ide>")
$ CST.runTokenParser CST.parseImportDeclP
$ CST.lex t of
Right (_, mn, idt, mmn) ->
Just (Import mn idt mmn)
_ -> Nothing
joinSections :: ([Text], [Text], [Text]) -> [Text]
joinSections (pre, decls, post) = pre `joinLine` (decls `joinLine` post)
where
isBlank = T.all (== ' ')
joinLine as bs
| Just ln1 <- lastMay as
, Just ln2 <- head bs
, not (isBlank ln1) && not (isBlank ln2) =
as ++ [""] ++ bs
| otherwise =
as ++ bs