a1a37e6 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

[psc-ide] Collect type class instances (#2592)

* [psc-ide] Add instances field to IdeTypeClass declarations * introduces ModuleMap synonym * decompose instance extraction * remove Module alias. This is way too ambiguous of a Name in the context of psc-ide * cleans up resolving pipeline stops lots of redundant ModuleNames being passed around and simplifies some of the types involved * test instance resolving

commita1a37e6c3e62637514bfb0d2f376dce50cc2b303 authorChristoph Hegemann <kRITZCREEK@users.noreply.github.com> dateMon 23 Jan 2017, 06:41 (10 years ago) parentc9446fb

14 files changed+235−106

compare with golang

unifiedsplit

purescript.cabal+1

@@ -542,6 +542,7 @@ test-suite tests

542542 hspec -any,

543543 hspec-discover -any,

544544 HUnit -any,

545+ lens -any,

545546 mtl -any,

546547 optparse-applicative -any,

547548 parsec -any,

src/Language/PureScript/Ide/Completion.hs+3

@@ -8,6 +8,9 @@ import Protolude

88import Language.PureScript.Ide.Filter

99import Language.PureScript.Ide.Matcher

1010import Language.PureScript.Ide.Types

11+import qualified Language.PureScript as P

12+

13+type Module = (P.ModuleName, [IdeDeclarationAnn])

1114

1215-- | Applies the CompletionFilters and the Matcher to the given Modules

1316-- and sorts the found Completions according to the Matching Score

src/Language/PureScript/Ide/Externs.hs+14−11

@@ -54,9 +54,9 @@ readExternFile fp = do

5454 where

5555 version = toS (showVersion P.version)

5656

57−convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])

57+convertExterns :: P.ExternsFile -> ([IdeDeclarationAnn], [(P.ModuleName, P.DeclarationRef)])

5858convertExterns ef =

59− ((P.efModuleName ef, decls), exportDecls)

59+ (decls, exportDecls)

6060 where

6161 decls = map

6262 (IdeDeclarationAnn emptyAnn)

@@ -71,8 +71,10 @@ convertExterns ef =

7171

7272removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]

7373removeTypeDeclarationsForClass (IdeDeclTypeClass n) = Endo (filter notDuplicate)

74− where notDuplicate (IdeDeclType t) = n ^. properNameT /= t ^. ideTypeName . properNameT

75− notDuplicate (IdeDeclTypeSynonym s) = n ^. properNameT /= s ^. ideSynonymName . properNameT

74+ where notDuplicate (IdeDeclType t) =

75+ n ^. ideTCName . properNameT /= t ^. ideTypeName . properNameT

76+ notDuplicate (IdeDeclTypeSynonym s) =

77+ n ^. ideTCName . properNameT /= s ^. ideSynonymName . properNameT

7678 notDuplicate _ = True

7779removeTypeDeclarationsForClass _ = mempty

7880

@@ -93,7 +95,8 @@ convertDecl P.EDDataConstructor{..} = Just $ IdeDeclDataConstructor $

9395 IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType

9496convertDecl P.EDValue{..} = Just $ IdeDeclValue $

9597 IdeValue edValueName edValueType

96−convertDecl P.EDClass{..} = Just (IdeDeclTypeClass edClassName)

98+convertDecl P.EDClass{..} = Just $ IdeDeclTypeClass $

99+ IdeTypeClass edClassName []

97100convertDecl P.EDKind{..} = Just (IdeDeclKind edKindName)

98101convertDecl P.EDInstance{} = Nothing

99102

@@ -117,10 +120,10 @@ convertTypeOperator P.ExternsTypeFixity{..} =

117120

118121annotateModule

119122 :: (DefinitionSites P.SourceSpan, TypeAnnotations)

120− -> Module

121− -> Module

122−annotateModule (defs, types) (moduleName, decls) =

123− (moduleName, map convertDeclaration decls)

123+ -> [IdeDeclarationAnn]

124+ -> [IdeDeclarationAnn]

125+annotateModule (defs, types) decls =

126+ map convertDeclaration decls

124127 where

125128 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

126129 convertDeclaration (IdeDeclarationAnn ann d) = case d of

@@ -132,8 +135,8 @@ annotateModule (defs, types) (moduleName, decls) =

132135 annotateType (s ^. ideSynonymName . properNameT) (IdeDeclTypeSynonym s)

133136 IdeDeclDataConstructor dtor ->

134137 annotateValue (dtor ^. ideDtorName . properNameT) (IdeDeclDataConstructor dtor)

135− IdeDeclTypeClass i ->

136− annotateType (i ^. properNameT) (IdeDeclTypeClass i)

138+ IdeDeclTypeClass tc ->

139+ annotateType (tc ^. ideTCName . properNameT) (IdeDeclTypeClass tc)

137140 IdeDeclValueOperator op ->

138141 annotateValue (op ^. ideValueOpAlias & valueOperatorAliasT) (IdeDeclValueOperator op)

139142 IdeDeclTypeOperator op ->

src/Language/PureScript/Ide/Filter.hs+2

@@ -32,6 +32,8 @@ import Language.PureScript.Ide.Util

3232

3333newtype Filter = Filter (Endo [Module]) deriving(Monoid)

3434

35+type Module = (P.ModuleName, [IdeDeclarationAnn])

36+

3537mkFilter :: ([Module] -> [Module]) -> Filter

3638mkFilter = Filter . Endo

3739

src/Language/PureScript/Ide/Imports.hs+2−2

@@ -197,8 +197,8 @@ addExplicitImport' decl moduleName imports =

197197 then imports

198198 else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports

199199 where

200− refFromDeclaration (IdeDeclTypeClass n) =

201− P.TypeClassRef n

200+ refFromDeclaration (IdeDeclTypeClass tc) =

201+ P.TypeClassRef (tc ^. ideTCName)

202202 refFromDeclaration (IdeDeclDataConstructor dtor) =

203203 P.TypeRef (dtor ^. ideDtorTypeName) Nothing

204204 refFromDeclaration (IdeDeclType t) =

src/Language/PureScript/Ide/Rebuild.hs+3−3

@@ -103,8 +103,8 @@ rebuildModuleOpen makeEnv externs m = void $ runExceptT $ do

103103data MakeActionsEnv =

104104 MakeActionsEnv

105105 { maeOutputDirectory :: FilePath

106− , maeFilePathMap :: Map P.ModuleName (Either P.RebuildPolicy FilePath)

107− , maeForeignPathMap :: Map P.ModuleName FilePath

106+ , maeFilePathMap :: ModuleMap (Either P.RebuildPolicy FilePath)

107+ , maeForeignPathMap :: ModuleMap FilePath

108108 , maePrefixComment :: Bool

109109 }

110110

@@ -134,7 +134,7 @@ shushCodegen ma MakeActionsEnv{..} =

134134sortExterns

135135 :: (Ide m, MonadError PscIdeError m)

136136 => P.Module

137− -> Map P.ModuleName P.ExternsFile

137+ -> ModuleMap P.ExternsFile

138138 -> m [P.ExternsFile]

139139sortExterns m ex = do

140140 sorted' <- runExceptT

src/Language/PureScript/Ide/Reexports.hs+33−22

@@ -18,25 +18,25 @@ module Language.PureScript.Ide.Reexports

1818 , prettyPrintReexportResult

1919 , reexportHasFailures

2020 , ReexportResult(..)

21+ -- for tests

22+ , resolveReexports'

2123 ) where

2224

2325import Protolude

2426

25−import Control.Lens hiding ((&))

26−

2727import qualified Data.Map as Map

2828import qualified Language.PureScript as P

2929import Language.PureScript.Ide.Types

3030import Language.PureScript.Ide.Util

3131

32−-- | Contains the module with resolved reexports, and eventual failures

32+-- | Contains the module with resolved reexports, and possible failures

3333data ReexportResult a

3434 = ReexportResult

3535 { reResolved :: a

3636 , reFailed :: [(P.ModuleName, P.DeclarationRef)]

3737 } deriving (Show, Eq, Functor)

3838

39−-- | Uses the passed formatter to format the resolved module, and adds eventual

39+-- | Uses the passed formatter to format the resolved module, and adds possible

4040-- failures

4141prettyPrintReexportResult

4242 :: (a -> Text)

@@ -56,16 +56,27 @@ prettyPrintReexportResult f ReexportResult{..}

5656reexportHasFailures :: ReexportResult a -> Bool

5757reexportHasFailures = not . null . reFailed

5858

59−-- | Resolves Reexports for a given Module, by looking up the reexported values

60−-- from the passed in Map

59+-- | Resolves Reexports for the given Modules, by looking up the reexported

60+-- values from the passed in DeclarationRefs

6161resolveReexports

62− :: Map P.ModuleName [IdeDeclarationAnn]

62+ :: ModuleMap [(P.ModuleName, P.DeclarationRef)]

63+ -- ^ the references to resolve

64+ -> ModuleMap [IdeDeclarationAnn]

6365 -- ^ Modules to search for the reexported declarations

64− -> (Module, [(P.ModuleName, P.DeclarationRef)])

65− -- ^ The module to resolve reexports for, aswell as the references to resolve

66− -> ReexportResult Module

67−resolveReexports modules ((moduleName, decls), refs) =

68− ReexportResult (moduleName, decls <> concat resolvedRefs) failedRefs

66+ -> ModuleMap (ReexportResult [IdeDeclarationAnn])

67+resolveReexports reexportRefs modules =

68+ Map.mapWithKey (\moduleName decls ->

69+ maybe (ReexportResult decls [])

70+ (resolveReexports' modules decls)

71+ (Map.lookup moduleName reexportRefs)) modules

72+

73+resolveReexports'

74+ :: ModuleMap [IdeDeclarationAnn]

75+ -> [IdeDeclarationAnn]

76+ -> [(P.ModuleName, P.DeclarationRef)]

77+ -> ReexportResult [IdeDeclarationAnn]

78+resolveReexports' modules decls refs =

79+ ReexportResult (decls <> concat resolvedRefs) failedRefs

6980 where

7081 (failedRefs, resolvedRefs) = partitionEithers (resolveRef' <$> refs)

7182 resolveRef' x@(mn, r) = case Map.lookup mn modules of

@@ -78,7 +89,7 @@ resolveRef

7889 -> Either P.DeclarationRef [IdeDeclarationAnn]

7990resolveRef decls ref = case ref of

8091 P.TypeRef tn mdtors ->

81− case findRef (\x -> x ^? _IdeDeclType . ideTypeName <&> (== tn) & fromMaybe False) of

92+ case findRef (lensSatisfies (_IdeDeclType . ideTypeName) (== tn)) of

8293 Nothing -> Left ref

8394 Just d -> Right $ d : case mdtors of

8495 Nothing ->

@@ -88,13 +99,13 @@ resolveRef decls ref = case ref of

8899 findDtors tn

89100 Just dtors -> mapMaybe lookupDtor dtors

90101 P.ValueRef i ->

91− findWrapped (\x -> x ^? _IdeDeclValue . ideValueIdent <&> (== i) & fromMaybe False)

102+ findWrapped (lensSatisfies (_IdeDeclValue . ideValueIdent) (== i))

92103 P.ValueOpRef name ->

93− findWrapped (\x -> x ^? _IdeDeclValueOperator . ideValueOpName <&> (== name) & fromMaybe False)

104+ findWrapped (lensSatisfies (_IdeDeclValueOperator . ideValueOpName) (== name))

94105 P.TypeOpRef name ->

95− findWrapped (\x -> x ^? _IdeDeclTypeOperator . ideTypeOpName <&> (== name) & fromMaybe False)

106+ findWrapped (lensSatisfies (_IdeDeclTypeOperator . ideTypeOpName) (== name))

96107 P.TypeClassRef name ->

97− findWrapped (\case IdeDeclTypeClass n -> n == name; _ -> False)

108+ findWrapped (lensSatisfies (_IdeDeclTypeClass . ideTCName) (== name))

98109 _ ->

99110 Left ref

100111 where

@@ -102,9 +113,9 @@ resolveRef decls ref = case ref of

102113 findRef f = find (f . discardAnn) decls

103114

104115 lookupDtor name =

105− findRef (\x -> x ^? _IdeDeclDataConstructor . ideDtorName <&> (== name) & fromMaybe False)

116+ findRef (lensSatisfies (_IdeDeclDataConstructor . ideDtorName) (== name))

106117

107− findDtors tn = filter (f . discardAnn) decls

108− where

109− f :: IdeDeclaration -> Bool

110− f decl = decl ^? _IdeDeclDataConstructor . ideDtorTypeName <&> (== tn) & fromMaybe False

118+ findDtors tn = filter (lensSatisfies

119+ (idaDeclaration

120+ . _IdeDeclDataConstructor

121+ . ideDtorTypeName) (== tn)) decls

src/Language/PureScript/Ide/State.hs+74−27

@@ -14,6 +14,7 @@

1414

1515{-# LANGUAGE PackageImports #-}

1616{-# LANGUAGE TemplateHaskell #-}

17+{-# LANGUAGE NamedFieldPuns #-}

1718

1819module Language.PureScript.Ide.State

1920 ( getLoadedModulenames

@@ -29,10 +30,12 @@ module Language.PureScript.Ide.State

2930 , populateStage3STM

3031 -- for tests

3132 , resolveOperatorsForModule

33+ , resolveInstances

3234 ) where

3335

3436import Protolude

3537

38+import Control.Arrow

3639import Control.Concurrent.STM

3740import Control.Lens hiding (op, (&))

3841import "monad-logger" Control.Monad.Logger

@@ -58,7 +61,7 @@ getLoadedModulenames :: Ide m => m [P.ModuleName]

5861getLoadedModulenames = Map.keys <$> getExternFiles

5962

6063-- | Gets all loaded ExternFiles

61−getExternFiles :: Ide m => m (Map P.ModuleName ExternsFile)

64+getExternFiles :: Ide m => m (ModuleMap ExternsFile)

6265getExternFiles = s1Externs <$> getStage1

6366

6467-- | Insert a Module into Stage1 of the State

@@ -121,7 +124,7 @@ setStage3STM ref s3 = do

121124-- | Checks if the given ModuleName matches the last rebuild cache and if it

122125-- does returns all loaded definitions + the definitions inside the rebuild

123126-- cache

124−getAllModules :: Ide m => Maybe P.ModuleName -> m [Module]

127+getAllModules :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclarationAnn])]

125128getAllModules mmoduleName = do

126129 declarations <- s3Declarations <$> getStage3

127130 rebuild <- cachedRebuild

@@ -136,7 +139,7 @@ getAllModules mmoduleName = do

136139 ast =

137140 fromMaybe (Map.empty, Map.empty) (Map.lookup moduleName asts)

138141 cachedModule =

139− snd . annotateModule ast . fst . convertExterns $ ef

142+ annotateModule ast (fst (convertExterns ef))

140143 tmp =

141144 Map.insert moduleName cachedModule declarations

142145 resolved =

@@ -192,43 +195,84 @@ populateStage3 = do

192195 st <- ideStateVar <$> ask

193196 let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration

194197 results <- logPerf message (liftIO (atomically (populateStage3STM st)))

195− traverse_

196− (logWarnN . prettyPrintReexportResult (P.runModuleName . fst))

197− (filter reexportHasFailures results)

198+ void $ Map.traverseWithKey

199+ (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))

200+ (Map.filter reexportHasFailures results)

198201

199202-- | STM version of populateStage3

200−populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]

203+populateStage3STM

204+ :: TVar IdeState

205+ -> STM (ModuleMap (ReexportResult [IdeDeclarationAnn]))

201206populateStage3STM ref = do

202207 externs <- s1Externs <$> getStage1STM ref

203208 (AstData asts) <- s2AstData <$> getStage2STM ref

204− let modules = Map.map convertExterns externs

205− nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])

206− nModules = Map.mapWithKey

207− (\moduleName (m, refs) ->

208− (fromMaybe m $ annotateModule <$> Map.lookup moduleName asts <*> pure m, refs)) modules

209− -- resolves reexports and discards load failures for now

210− result = resolveReexports (map (snd . fst) nModules) <$> Map.elems nModules

211− resultP = resolveOperators (Map.fromList (reResolved <$> result))

212− setStage3STM ref (Stage3 resultP Nothing)

213− pure result

209+ let (modules, reexportRefs) = (map fst &&& map snd) (Map.map convertExterns externs)

210+ results =

211+ resolveLocations asts modules

212+ & resolveInstances externs

213+ & resolveOperators

214+ & resolveReexports reexportRefs

215+ setStage3STM ref (Stage3 (map reResolved results) Nothing)

216+ pure results

217+

218+

219+resolveLocations

220+ :: ModuleMap (DefinitionSites P.SourceSpan, TypeAnnotations)

221+ -> ModuleMap [IdeDeclarationAnn]

222+ -> ModuleMap [IdeDeclarationAnn]

223+resolveLocations asts =

224+ Map.mapWithKey (\mn decls ->

225+ maybe decls (flip annotateModule decls) (Map.lookup mn asts))

226+

227+resolveInstances

228+ :: ModuleMap P.ExternsFile

229+ -> ModuleMap [IdeDeclarationAnn]

230+ -> ModuleMap [IdeDeclarationAnn]

231+resolveInstances externs declarations =

232+ Map.foldr (flip (foldr go)) declarations

233+ . Map.mapWithKey (\mn ef -> mapMaybe (extractInstances mn) (efDeclarations ef))

234+ $ externs

235+ where

236+ extractInstances mn P.EDInstance{..} =

237+ case edInstanceClassName of

238+ P.Qualified (Just classModule) className ->

239+ Just (IdeInstance mn

240+ edInstanceName

241+ edInstanceTypes

242+ edInstanceConstraints, classModule, className)

243+ _ -> Nothing

244+ extractInstances _ _ = Nothing

245+

246+ go ::

247+ (IdeInstance, P.ModuleName, P.ProperName 'P.ClassName)

248+ -> ModuleMap [IdeDeclarationAnn]

249+ -> ModuleMap [IdeDeclarationAnn]

250+ go (ideInstance, classModule, className) acc' =

251+ let

252+ matchTC =

253+ lensSatisfies (idaDeclaration . _IdeDeclTypeClass . ideTCName) (== className)

254+ updateDeclaration =

255+ mapIf matchTC (idaDeclaration

256+ . _IdeDeclTypeClass

257+ . ideTCInstances

258+ %~ cons ideInstance)

259+ in

260+ acc' & ix classModule %~ updateDeclaration

214261

215262resolveOperators

216− :: Map P.ModuleName [IdeDeclarationAnn]

217− -> Map P.ModuleName [IdeDeclarationAnn]

263+ :: ModuleMap [IdeDeclarationAnn]

264+ -> ModuleMap [IdeDeclarationAnn]

218265resolveOperators modules =

219266 map (resolveOperatorsForModule modules) modules

220267

221268-- | Looks up the types and kinds for operators and assigns them to their

222269-- declarations

223270resolveOperatorsForModule

224− :: Map P.ModuleName [IdeDeclarationAnn]

271+ :: ModuleMap [IdeDeclarationAnn]

225272 -> [IdeDeclarationAnn]

226273 -> [IdeDeclarationAnn]

227−resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

274+resolveOperatorsForModule modules = map (idaDeclaration %~ resolveOperator)

228275 where

229− hasName :: Eq b => Lens' a b -> b -> a -> Bool

230− hasName l a x = x ^. l == a

231−

232276 getDeclarations :: P.ModuleName -> [IdeDeclaration]

233277 getDeclarations moduleName =

234278 Map.lookup moduleName modules

@@ -239,14 +283,14 @@ resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

239283 | (P.Qualified (Just mn) (Left ident)) <- op ^. ideValueOpAlias =

240284 let t = getDeclarations mn

241285 & mapMaybe (preview _IdeDeclValue)

242− & filter (hasName ideValueIdent ident)

286+ & filter (lensSatisfies ideValueIdent (== ident))

243287 & map (view ideValueType)

244288 & listToMaybe

245289 in IdeDeclValueOperator (op & ideValueOpType .~ t)

246290 | (P.Qualified (Just mn) (Right dtor)) <- op ^. ideValueOpAlias =

247291 let t = getDeclarations mn

248292 & mapMaybe (preview _IdeDeclDataConstructor)

249− & filter (hasName ideDtorName dtor)

293+ & filter (lensSatisfies ideDtorName (== dtor))

250294 & map (view ideDtorType)

251295 & listToMaybe

252296 in IdeDeclValueOperator (op & ideValueOpType .~ t)

@@ -254,9 +298,12 @@ resolveOperatorsForModule modules = map ((over idaDeclaration) resolveOperator)

254298 | P.Qualified (Just mn) properName <- op ^. ideTypeOpAlias =

255299 let k = getDeclarations mn

256300 & mapMaybe (preview _IdeDeclType)

257− & filter (hasName ideTypeName properName)

301+ & filter (lensSatisfies ideTypeName (== properName))

258302 & map (view ideTypeKind)

259303 & listToMaybe

260304 in IdeDeclTypeOperator (op & ideTypeOpKind .~ k)

261305 resolveOperator x = x

262306

307+

308+mapIf :: Functor f => (b -> Bool) -> (b -> b) -> f b -> f b

309+mapIf p f = map (\x -> if p x then f x else x)

src/Language/PureScript/Ide/Types.hs+20−7

@@ -27,13 +27,14 @@ import qualified Language.PureScript as P

2727import qualified Language.PureScript.Errors.JSON as P

2828

2929type ModuleIdent = Text

30+type ModuleMap a = Map P.ModuleName a

3031

3132data IdeDeclaration

3233 = IdeDeclValue IdeValue

3334 | IdeDeclType IdeType

3435 | IdeDeclTypeSynonym IdeSynonym

3536 | IdeDeclDataConstructor IdeDataConstructor

36− | IdeDeclTypeClass (P.ProperName 'P.ClassName)

37+ | IdeDeclTypeClass IdeTypeClass

3738 | IdeDeclValueOperator IdeValueOperator

3839 | IdeDeclTypeOperator IdeTypeOperator

3940 | IdeDeclKind (P.ProperName 'P.KindName)

@@ -60,6 +61,18 @@ data IdeDataConstructor = IdeDataConstructor

6061 , _ideDtorType :: P.Type

6162 } deriving (Show, Eq, Ord)

6263

64+data IdeTypeClass = IdeTypeClass

65+ { _ideTCName :: P.ProperName 'P.ClassName

66+ , _ideTCInstances :: [IdeInstance]

67+ } deriving (Show, Eq, Ord)

68+

69+data IdeInstance = IdeInstance

70+ { _ideInstanceModule :: P.ModuleName

71+ , _ideInstanceName :: P.Ident

72+ , _ideInstanceTypes :: [P.Type]

73+ , _ideInstanceConstraints :: Maybe [P.Constraint]

74+ } deriving (Show, Eq, Ord)

75+

6376data IdeValueOperator = IdeValueOperator

6477 { _ideValueOpName :: P.OpName 'P.ValueOpName

6578 , _ideValueOpAlias :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))

@@ -81,6 +94,8 @@ makeLenses ''IdeValue

8194makeLenses ''IdeType

8295makeLenses ''IdeSynonym

8396makeLenses ''IdeDataConstructor

97+makeLenses ''IdeTypeClass

98+makeLenses ''IdeInstance

8499makeLenses ''IdeValueOperator

85100makeLenses ''IdeTypeOperator

86101

@@ -101,11 +116,9 @@ makeLenses ''IdeDeclarationAnn

101116emptyAnn :: Annotation

102117emptyAnn = Annotation Nothing Nothing Nothing

103118

104−type Module = (P.ModuleName, [IdeDeclarationAnn])

105−

106119type DefinitionSites a = Map IdeDeclNamespace a

107120type TypeAnnotations = Map P.Ident P.Type

108−newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))

121+newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))

109122 -- ^ SourceSpans for the definition sites of Values and Types aswell as type

110123 -- annotations found in a module

111124 deriving (Show, Eq, Ord, Functor, Foldable)

@@ -147,8 +160,8 @@ emptyStage3 :: Stage3

147160emptyStage3 = Stage3 M.empty Nothing

148161

149162data Stage1 = Stage1

150− { s1Externs :: M.Map P.ModuleName P.ExternsFile

151− , s1Modules :: M.Map P.ModuleName (P.Module, FilePath)

163+ { s1Externs :: ModuleMap P.ExternsFile

164+ , s1Modules :: ModuleMap (P.Module, FilePath)

152165 }

153166

154167data Stage2 = Stage2

@@ -156,7 +169,7 @@ data Stage2 = Stage2

156169 }

157170

158171data Stage3 = Stage3

159− { s3Declarations :: M.Map P.ModuleName [IdeDeclarationAnn]

172+ { s3Declarations :: ModuleMap [IdeDeclarationAnn]

160173 , s3CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

161174 }

162175

src/Language/PureScript/Ide/Util.hs+12−7

@@ -27,15 +27,17 @@ module Language.PureScript.Ide.Util

2727 , prettyTypeT

2828 , properNameT

2929 , identT

30+ , lensSatisfies

3031 , module Language.PureScript.Ide.Logging

3132 ) where

3233

3334import Protolude hiding (decodeUtf8,

3435 encodeUtf8)

3536

36−import Control.Lens ((^.), Iso', iso)

37+import Control.Lens ((^.), (^?), Iso', iso, Getting, (<&>))

3738import Data.Aeson

3839import qualified Data.Text as T

40+import qualified Data.Text.Lazy as TL

3941import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)

4042import qualified Language.PureScript as P

4143import Language.PureScript.Ide.Logging

@@ -47,7 +49,7 @@ identifierFromIdeDeclaration d = case d of

4749 IdeDeclType t -> t ^. ideTypeName . properNameT

4850 IdeDeclTypeSynonym s -> s ^. ideSynonymName . properNameT

4951 IdeDeclDataConstructor dtor -> dtor ^. ideDtorName . properNameT

50− IdeDeclTypeClass name -> P.runProperName name

52+ IdeDeclTypeClass tc -> tc ^. ideTCName . properNameT

5153 IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName

5254 IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName

5355 IdeDeclKind name -> P.runProperName name

@@ -67,14 +69,14 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =

6769 where

6870 (complIdentifier, complExpandedType) = case decl of

6971 IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyTypeT)

70− IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind & toS )

72+ IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)

7173 IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyTypeT)

7274 IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyTypeT)

73− IdeDeclTypeClass name -> (P.runProperName name, "class")

75+ IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, "type class")

7476 IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->

7577 (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP)

7678 IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->

77− (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)

79+ (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)

7880 IdeDeclKind k -> (P.runProperName k, "kind")

7981

8082 complModule = P.runModuleName m

@@ -103,10 +105,10 @@ typeOperatorAliasT i =

103105 P.showQualified P.runProperName i

104106

105107encodeT :: (ToJSON a) => a -> Text

106−encodeT = toS . decodeUtf8 . encode

108+encodeT = TL.toStrict . decodeUtf8 . encode

107109

108110decodeT :: (FromJSON a) => Text -> Maybe a

109−decodeT = decode . encodeUtf8 . toS

111+decodeT = decode . encodeUtf8 . TL.fromStrict

110112

111113unwrapPositioned :: P.Declaration -> P.Declaration

112114unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x

@@ -129,3 +131,6 @@ prettyTypeT =

129131 . T.lines

130132 . T.pack

131133 . P.prettyPrintTypeWithUnicode

134+

135+lensSatisfies :: forall a s. Getting (First a) s a -> (a -> Bool) -> s -> Bool

136+lensSatisfies getter predicate value = value ^? getter <&> predicate & fromMaybe False

tests/Language/PureScript/Ide/FilterSpec.hs+2

@@ -8,6 +8,8 @@ import Language.PureScript.Ide.Types

88import qualified Language.PureScript as P

99import Test.Hspec

1010

11+type Module = (P.ModuleName, [IdeDeclarationAnn])

12+

1113value :: Text -> IdeDeclarationAnn

1214value s = IdeDeclarationAnn emptyAnn (IdeDeclValue (IdeValue (P.Ident (toS s)) P.REmpty))

1315

tests/Language/PureScript/Ide/ImportsSpec.hs+1−1

@@ -144,7 +144,7 @@ spec = do

144144 addImport imports import' = addExplicitImport' import' moduleName imports

145145 valueImport ident = (IdeDeclValue (IdeValue (P.Ident ident) wildcard))

146146 typeImport name = (IdeDeclType (IdeType (P.ProperName name) P.kindType))

147− classImport name = (IdeDeclTypeClass (P.ProperName name))

147+ classImport name = (IdeDeclTypeClass (IdeTypeClass (P.ProperName name) []))

148148 dtorImport name typeName = (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName name) (P.ProperName typeName) wildcard))

149149 -- expect any list of provided identifiers, when imported, to come out as specified

150150 expectSorted imports expected = shouldBe

tests/Language/PureScript/Ide/ReexportsSpec.hs+15−13

@@ -10,6 +10,8 @@ import Language.PureScript.Ide.Types

1010import qualified Language.PureScript as P

1111import Test.Hspec

1212

13+type Module = (P.ModuleName, [IdeDeclarationAnn])

14+

1315m :: Text -> P.ModuleName

1416m = P.moduleNameFromString

1517

@@ -19,32 +21,32 @@ d = IdeDeclarationAnn emptyAnn

1921valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn

2022valueA = d (IdeDeclValue (IdeValue (P.Ident "valueA") P.REmpty))

2123typeA = d (IdeDeclType (IdeType(P.ProperName "TypeA") P.kindType))

22−classA = d (IdeDeclTypeClass (P.ProperName "ClassA"))

24+classA = d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "ClassA") []))

2325dtorA1 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty))

2426dtorA2 = d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty))

2527

26−env :: Map P.ModuleName [IdeDeclarationAnn]

28+env :: ModuleMap [IdeDeclarationAnn]

2729env = Map.fromList

2830 [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])

2931 ]

3032

3133type Refs = [(P.ModuleName, P.DeclarationRef)]

3234

33−succTestCases :: [(Text, Module, Refs, Module)]

35+succTestCases :: [(Text, [IdeDeclarationAnn], Refs, [IdeDeclarationAnn])]

3436succTestCases =

35− [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))

37+ [ ("resolves a value reexport", [], [(m "A", P.ValueRef (P.Ident "valueA"))], [valueA])

3638 , ("resolves a type reexport with explicit data constructors"

37− , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], (m "C", [typeA, dtorA1]))

39+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA, dtorA1])

3840 , ("resolves a type reexport with implicit data constructors"

39− , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))

40− , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))

41+ , [], [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], [typeA, dtorA1, dtorA2])

42+ , ("resolves a class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA])

4143 ]

4244

43−failTestCases :: [(Text, Module, Refs)]

45+failTestCases :: [(Text, [IdeDeclarationAnn], Refs)]

4446failTestCases =

45− [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])

46− , ("fails to resolve a non existing type reexport" , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])

47− , ("fails to resolve a non existing class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

47+ [ ("fails to resolve a non existing value", [], [(m "A", P.ValueRef (P.Ident "valueB"))])

48+ , ("fails to resolve a non existing type reexport" , [], [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])

49+ , ("fails to resolve a non existing class reexport", [], [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

4850 ]

4951

5052spec :: Spec

@@ -52,12 +54,12 @@ spec = do

5254 describe "Successful Reexports" $

5355 for_ succTestCases $ \(desc, initial, refs, result) ->

5456 it (toS desc) $ do

55− let reResult = resolveReexports env (initial, refs)

57+ let reResult = resolveReexports' env initial refs

5658 reResolved reResult `shouldBe` result

5759 reResult `shouldSatisfy` not . reexportHasFailures

5860 describe "Failed Reexports" $

5961 for_ failTestCases $ \(desc, initial, refs) ->

6062 it (toS desc) $ do

61− let reResult = resolveReexports env (initial, refs)

63+ let reResult = resolveReexports' env initial refs

6264 reFailed reResult `shouldBe` refs

6365 reResult `shouldSatisfy` reexportHasFailures

tests/Language/PureScript/Ide/StateSpec.hs+53−13

@@ -3,6 +3,7 @@

33module Language.PureScript.Ide.StateSpec where

55import Protolude

6+import Control.Lens hiding ((&))

67import Language.PureScript.Ide.Types

78import Language.PureScript.Ide.State

89import qualified Language.PureScript as P

@@ -21,7 +22,7 @@ typeOperator :: Maybe P.Kind -> IdeDeclarationAnn

2122typeOperator =

2223 d . IdeDeclTypeOperator . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix

2324

24−testModule :: Module

25+testModule :: (P.ModuleName, [IdeDeclarationAnn])

2526testModule = (mn "Test", [ d (IdeDeclValue (IdeValue (P.Ident "function") P.REmpty))

2627 , d (IdeDeclDataConstructor (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty)))

2728 , d (IdeDeclType (IdeType (P.ProperName "List") P.kindType))

@@ -34,18 +35,57 @@ d :: IdeDeclaration -> IdeDeclarationAnn

3435d = IdeDeclarationAnn emptyAnn

3536

3637mn :: Text -> P.ModuleName

37−mn = P.moduleNameFromString . toS

38+mn = P.moduleNameFromString

3839

39−testState :: Map P.ModuleName [IdeDeclarationAnn]

40−testState = Map.fromList

41− [ testModule

42− ]

40+testState :: ModuleMap [IdeDeclarationAnn]

41+testState = Map.fromList [testModule]

42+

43+-- The accessor fields for these data types are not exposed unfortunately

44+ef :: P.ExternsFile

45+ef = P.ExternsFile

46+ -- { efVersion =

47+ mempty

48+ -- , efModuleName =

49+ (mn "InstanceModule")

50+ -- , efExports =

51+ mempty

52+ -- , efImports =

53+ mempty

54+ -- , efFixities =

55+ mempty

56+ -- , efTypeFixities =

57+ mempty

58+ --, efDeclarations =

59+ [ P.EDInstance

60+ -- { edInstanceClassName =

61+ (P.Qualified (Just (mn "ClassModule")) (P.ProperName "MyClass"))

62+ -- , edInstanceName =

63+ (P.Ident "myClassInstance")

64+ -- , edInstanceTypes =

65+ mempty

66+ -- , edInstanceConstraints =

67+ mempty

68+ -- }

69+ ]

70+ -- }

71+

72+moduleMap :: ModuleMap [IdeDeclarationAnn]

73+moduleMap = Map.singleton (mn "ClassModule") [d (IdeDeclTypeClass (IdeTypeClass (P.ProperName "MyClass") []))]

74+

75+ideInstance :: IdeInstance

76+ideInstance = IdeInstance (mn "InstanceModule") (P.Ident "myClassInstance") mempty mempty

4377

4478spec :: Spec

45−spec = describe "resolving operators" $ do

46− it "resolves the type for a value operator" $

47− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

48− it "resolves the type for a constructor operator" $

49− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

50− it "resolves the kind for a type operator" $

51− resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))

79+spec = do

80+ describe "resolving operators" $ do

81+ it "resolves the type for a value operator" $

82+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))

83+ it "resolves the type for a constructor operator" $

84+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))

85+ it "resolves the kind for a type operator" $

86+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))

87+ describe "resolving instances for type classes" $ do

88+ it "resolves an instance for an existing type class" $ do

89+ resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap

90+ `shouldSatisfy`

91+ elemOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) ideInstance