@@ -0,0 +1,355 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Ide.Imports
4+-- Description : Provides functionality to manage imports
5+-- Copyright : Christoph Hegemann 2016
6+-- License : MIT (http://opensource.org/licenses/MIT)
7+--
8+-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>
9+-- Stability : experimental
10+--
11+-- |
12+-- Provides functionality to manage imports
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE ConstraintKinds #-}
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE LambdaCase #-}
18+{-# LANGUAGE MultiParamTypeClasses #-}
19+{-# LANGUAGE OverloadedStrings #-}
20+{-# LANGUAGE PackageImports #-}
21+
22+module Language.PureScript.Ide.Imports
23+ ( addImplicitImport
24+ , addImportForIdentifier
25+ , answerRequest
26+ -- for tests
27+ , parseImport
28+ , prettyPrintImportSection
29+ , addImplicitImport'
30+ , addExplicitImport'
31+ , sliceImportSection
32+ , prettyPrintImport'
33+ , Import(Import)
34+ )
35+ where
36+
37+import Control.Applicative ((<|>))
38+import Control.Monad.Error.Class
39+import Control.Monad.IO.Class
40+import "monad-logger" Control.Monad.Logger
41+import Data.Bifunctor (first, second)
42+import Data.Function (on)
43+import qualified Data.List as List
44+import Data.Maybe (isNothing)
45+import Data.Monoid ((<>))
46+import Data.Text (Text)
47+import qualified Data.Text as T
48+import qualified Data.Text.IO as TIO
49+import qualified Language.PureScript as P
50+import Language.PureScript.Ide.Completion
51+import Language.PureScript.Ide.Error
52+import Language.PureScript.Ide.Externs (unwrapPositioned,
53+ unwrapPositionedRef)
54+import Language.PureScript.Ide.Filter
55+import Language.PureScript.Ide.State
56+import Language.PureScript.Ide.Types
57+import Language.PureScript.Ide.Util
58+
59+data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)
60+ deriving (Eq, Show)
61+
62+instance Ord Import where
63+ compare = compImport
64+
65+compImportType :: P.ImportDeclarationType -> P.ImportDeclarationType -> Ordering
66+compImportType P.Implicit P.Implicit = EQ
67+compImportType P.Implicit _ = LT
68+compImportType (P.Explicit _) (P.Hiding _) = LT
69+compImportType (P.Explicit _) (P.Explicit _) = EQ
70+compImportType (P.Explicit _) P.Implicit = GT
71+compImportType (P.Hiding _) (P.Hiding _) = EQ
72+compImportType (P.Hiding _) _ = GT
73+
74+compImport :: Import -> Import -> Ordering
75+compImport (Import n i q) (Import n' i' q')
76+ | compImportType i i' /= EQ = compImportType i i'
77+ -- This means that for a stable sort, the first implicit import will stay
78+ -- the first implicit import
79+ | P.isImplicit i && isNothing q = LT
80+ | P.isImplicit i && isNothing q' = GT
81+ | otherwise = compare n n'
82+
83+-- | Reads a file and returns the (lines before the imports, the imports, the
84+-- lines after the imports)
85+parseImportsFromFile :: (MonadIO m, MonadError PscIdeError m) =>
86+ FilePath -> m (P.ModuleName, [Text], [Import], [Text])
87+parseImportsFromFile fp = do
88+ file <- liftIO (TIO.readFile fp)
89+ case sliceImportSection (T.lines file) of
90+ Right res -> pure res
91+ Left err -> throwError (GeneralError err)
92+
93+parseImportsWithModuleName :: [Text] -> Either String (P.ModuleName, [Import])
94+parseImportsWithModuleName ls = do
95+ (P.Module _ _ mn decls _) <- moduleParse ls
96+ pure (mn, concatMap mkImport (unwrapPositioned <$> decls))
97+ where
98+ mkImport (P.ImportDeclaration mn (P.Explicit refs) qual _) =
99+ [Import mn (P.Explicit (unwrapPositionedRef <$> refs)) qual]
100+ mkImport (P.ImportDeclaration mn it qual _) = [Import mn it qual]
101+ mkImport _ = []
102+
103+sliceImportSection :: [Text] -> Either String (P.ModuleName, [Text], [Import], [Text])
104+sliceImportSection ts =
105+ case foldl step (ModuleHeader 0) (zip [0..] ts) of
106+ Res start end ->
107+ let
108+ (moduleHeader, (importSection, remainingFile)) =
109+ List.splitAt (succ (end - start)) `second` List.splitAt start ts
110+ in
111+ (\(mn, is) -> (mn, moduleHeader, is, remainingFile)) <$>
112+ parseImportsWithModuleName (moduleHeader <> importSection)
113+
114+ -- If we don't find any imports, we insert a newline after the module
115+ -- declaration and begin a new importsection
116+ ModuleHeader ix ->
117+ let (moduleHeader, remainingFile) = List.splitAt (succ ix) ts
118+ in
119+ (\(mn, is) -> (mn, moduleHeader ++ [""], is, remainingFile)) <$>
120+ parseImportsWithModuleName moduleHeader
121+ _ -> Left "Failed to detect the import section"
122+
123+data ImportStateMachine = ModuleHeader Int | ImportSection Int Int | Res Int Int
124+
125+-- | We start in the
126+--
127+-- * ModuleHeader state.
128+--
129+-- We skip every line we encounter, that doesn't start with "import". If we find
130+-- a line that starts with module we store that linenumber. Once we find a line
131+-- with "import" we store its linenumber as the start of the import section and
132+-- change into the
133+--
134+-- * ImportSection state
135+--
136+-- For any line that starts with import or whitespace(is thus indented) we
137+-- expand the end of the import section to that line and continue. If we
138+-- encounter a commented or empty line, we continue moving forward in the
139+-- ImportSection state but don't expand the import section end yet. This allows
140+-- us to exclude newlines or comments that directly follow the import section.
141+-- Once we encounter a line that is not a comment, newline, indentation or
142+-- import we switch into the
143+--
144+-- * Res state
145+--
146+-- , which just shortcuts to the end of the file and carries the detected import
147+-- section boundaries
148+step :: ImportStateMachine -> (Int, Text) -> ImportStateMachine
149+step (ModuleHeader mi) (ix, l)
150+ | T.isPrefixOf "module " l = ModuleHeader ix
151+ | T.isPrefixOf "import " l = ImportSection ix ix
152+ | otherwise = ModuleHeader mi
153+step (ImportSection start lastImportLine) (ix, l)
154+ | any (`T.isPrefixOf` l) ["import", " "] = ImportSection start ix
155+ | T.isPrefixOf "--" l || l == "" = ImportSection start lastImportLine
156+ | otherwise = Res start lastImportLine
157+step (Res start end) _ = Res start end
158+
159+moduleParse :: [Text] -> Either String P.Module
160+moduleParse t = first show $ do
161+ tokens <- (P.lex "" . T.unpack . T.unlines) t
162+ P.runTokenParser "<psc-ide>" P.parseModule tokens
163+
164+-- | Adds an implicit import like @import Prelude@ to a Sourcefile.
165+addImplicitImport :: (MonadIO m, MonadError PscIdeError m)
166+ => FilePath -- ^ The Sourcefile read from
167+ -> P.ModuleName -- ^ The module to import
168+ -> m [Text]
169+addImplicitImport fp mn = do
170+ (_, pre, imports, post) <- parseImportsFromFile fp
171+ let newImportSection = addImplicitImport' imports mn
172+ pure $ pre ++ newImportSection ++ post
173+
174+addImplicitImport' :: [Import] -> P.ModuleName -> [Text]
175+addImplicitImport' imports mn =
176+ -- We need to append the new import, because there could already be implicit
177+ -- imports and we need to preserve the order on these, as the first implicit
178+ -- import is the one that doesn't generate warnings.
179+ prettyPrintImportSection ( imports ++ [Import mn P.Implicit Nothing])
180+
181+-- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an
182+-- explicit import already exists for the given module, it adds the identifier
183+-- to that imports list.
184+--
185+-- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing
186+-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude
187+-- (bind, unit)"]@
188+addExplicitImport :: (MonadIO m, MonadError PscIdeError m, MonadLogger m) =>
189+ FilePath -> ExternDecl -> P.ModuleName -> m [Text]
190+addExplicitImport fp decl moduleName = do
191+ (mn, pre, imports, post) <- parseImportsFromFile fp
192+ let newImportSection =
193+ -- TODO: Open an issue when this PR is merged, we should optimise this
194+ -- so that this case does not write to disc
195+ if mn == moduleName
196+ then imports
197+ else addExplicitImport' decl moduleName imports
198+ pure (pre ++ prettyPrintImportSection newImportSection ++ post)
199+
200+addExplicitImport' :: ExternDecl -> P.ModuleName -> [Import] -> [Import]
201+addExplicitImport' decl moduleName imports =
202+ let
203+ isImplicitlyImported =
204+ not . null $ filter (\case
205+ (Import mn P.Implicit Nothing) -> mn == moduleName
206+ _ -> False) imports
207+ matches (Import mn (P.Explicit _) Nothing) = mn == moduleName
208+ matches _ = False
209+ freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) Nothing
210+ in
211+ if isImplicitlyImported
212+ then imports
213+ else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports
214+ where
215+ refFromDeclaration (TypeClassDeclaration n) = P.TypeClassRef n
216+ refFromDeclaration (DataConstructor n tn _) =
217+ P.TypeRef tn (Just [P.ProperName (T.unpack n)])
218+ refFromDeclaration (TypeDeclaration n _) = P.TypeRef n (Just [])
219+ refFromDeclaration d =
220+ let
221+ ident = T.unpack (identifierFromExternDecl d)
222+ in
223+ P.ValueRef ((if all P.isSymbolChar ident then P.Op else P.Ident) ident)
224+
225+ -- | Adds a declaration to an import:
226+ -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)
227+ insertDeclIntoImport :: ExternDecl -> Import -> Import
228+ insertDeclIntoImport decl' (Import mn (P.Explicit refs) Nothing) =
229+ Import mn (P.Explicit (insertDeclIntoRefs decl' refs)) Nothing
230+ insertDeclIntoImport _ is = is
231+
232+ insertDeclIntoRefs :: ExternDecl -> [P.DeclarationRef] -> [P.DeclarationRef]
233+ insertDeclIntoRefs (DataConstructor dtor tn _) refs =
234+ let
235+ dtor' = P.ProperName (T.unpack dtor)
236+ -- TODO: Get rid of this once typeclasses can't be imported like types
237+ refs' = properRefToTypeRef <$> refs
238+ in
239+ updateAtFirstOrPrepend (matchType tn) (insertDtor dtor') (P.TypeRef tn (Just [dtor'])) refs'
240+ insertDeclIntoRefs dr refs = List.nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)
241+
242+ insertDtor dtor (P.TypeRef tn' dtors) =
243+ case dtors of
244+ Just dtors' -> P.TypeRef tn' (Just (List.nub (dtor : dtors')))
245+ -- This means the import was opened. We don't add anything in this case
246+ -- import Data.Maybe (Maybe(..)) -> import Data.Maybe (Maybe(Just))
247+ Nothing -> P.TypeRef tn' Nothing
248+ insertDtor _ refs = refs
249+
250+
251+ -- TODO: Get rid of this once typeclasses can't be imported like types
252+ properRefToTypeRef (P.ProperRef n) = P.TypeRef (P.ProperName n) (Just [])
253+ properRefToTypeRef r = r
254+
255+ matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool
256+ matchType tn (P.TypeRef n _) = tn == n
257+ matchType _ _ = False
258+
259+updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]
260+updateAtFirstOrPrepend p t d l =
261+ case List.findIndex p l of
262+ Nothing -> d : l
263+ Just ix ->
264+ let (x, a : y) = List.splitAt ix l
265+ in x ++ [t a] ++ y
266+
267+-- | Looks up the given identifier in the currently loaded modules.
268+--
269+-- * Throws an error if the identifier cannot be found.
270+--
271+-- * If exactly one match is found, adds an explicit import to the importsection
272+--
273+-- * If more than one possible imports are found, reports the possibilities as a
274+-- list of completions.
275+addImportForIdentifier :: (PscIde m, MonadError PscIdeError m, MonadLogger m)
276+ => FilePath -- ^ The Sourcefile to read from
277+ -> Text -- ^ The identifier to import
278+ -> [Filter] -- ^ Filters to apply before searching for
279+ -- the identifier
280+ -> m (Either [Match] [Text])
281+addImportForIdentifier fp ident filters = do
282+ modules <- getAllModulesWithReexports
283+ case getExactMatches ident filters modules of
284+ [] ->
285+ throwError (NotFound "Couldn't find the given identifier. \
286+ \Have you loaded the corresponding module?")
287+
288+ -- Only one match was found for the given identifier, so we can insert it
289+ -- right away
290+ [Match m decl] ->
291+ Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m))
292+
293+ -- This case comes up for newtypes and dataconstructors. Because values and
294+ -- types don't share a namespace we can get multiple matches from the same
295+ -- module. This also happens for parameterized types, as these generate both
296+ -- a type aswell as a type synonym.
297+
298+ ms@[Match m1 d1, Match m2 d2] ->
299+ if m1 /= m2
300+ -- If the modules don't line up we just ask the user to specify the
301+ -- module
302+ then pure $ Left ms
303+ else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of
304+ -- If dataconstructor and type line up we just import the
305+ -- dataconstructor as that will give us an unnecessary import warning at
306+ -- worst
307+ Just decl ->
308+ Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m1))
309+ -- Here we need the user to specify whether he wanted a dataconstructor
310+ -- or a type
311+ Nothing ->
312+ throwError (GeneralError "Undecidable between type and dataconstructor")
313+
314+ -- Multiple matches were found so we need to ask the user to clarify which
315+ -- module he meant
316+ xs ->
317+ pure $ Left xs
318+ where
319+ decideRedundantCase dtor@(DataConstructor _ t _) (TypeDeclaration t' _) =
320+ if t == t' then Just dtor else Nothing
321+ decideRedundantCase TypeDeclaration{} ts@TypeSynonymDeclaration{} =
322+ Just ts
323+ decideRedundantCase _ _ = Nothing
324+
325+prettyPrintImport' :: Import -> Text
326+-- TODO: remove this clause once P.prettyPrintImport can properly handle PositionedRefs
327+prettyPrintImport' (Import mn (P.Explicit refs) qual) =
328+ T.pack $ "import " ++ P.prettyPrintImport mn (P.Explicit (unwrapPositionedRef <$> refs)) qual
329+prettyPrintImport' (Import mn idt qual) =
330+ T.pack $ "import " ++ P.prettyPrintImport mn idt qual
331+
332+prettyPrintImportSection :: [Import] -> [Text]
333+prettyPrintImportSection imports = map prettyPrintImport' (List.sort imports)
334+
335+-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,
336+-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the
337+-- first argument.
338+answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success
339+answerRequest outfp rs =
340+ case outfp of
341+ Nothing -> pure $ MultilineTextResult rs
342+ Just outfp' -> do
343+ liftIO $ TIO.writeFile outfp' (T.unlines rs)
344+ pure $ TextResult $ "Written to " <> T.pack outfp'
345+
346+-- | Test and ghci helper
347+parseImport :: Text -> Maybe Import
348+parseImport t =
349+ case P.lex "<psc-ide>" (T.unpack t)
350+ >>= P.runTokenParser "<psc-ide>" P.parseImportDeclaration' of
351+ Right (mn, P.Explicit refs, mmn, _) ->
352+ Just (Import mn (P.Explicit (unwrapPositionedRef <$> refs)) mmn)
353+ Right (mn, idt, mmn, _) -> Just (Import mn idt mmn)
354+ Left _ -> Nothing
355+