11-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22-- SPDX-License-Identifier: Apache-2.0
33
4- {-# LANGUAGE CPP #-}
5- {-# LANGUAGE GADTs #-}
6- {-# LANGUAGE RankNTypes #-}
4+ {-# LANGUAGE CPP #-}
5+ {-# LANGUAGE GADTs #-}
6+ {-# LANGUAGE RankNTypes #-}
7+ {-# LANGUAGE ScopedTypeVariables #-}
78
89-- | Gives information about symbols at a given point in DAML files.
910-- These are all pure functions that should execute quickly.
@@ -213,21 +214,33 @@ atPoint
213214 -> DocAndKindMap
214215 -> HscEnv
215216 -> Position
216- -> Maybe Maybe Range , [T. Text
217- atPoint IdeOptions {} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ pointCommand hf pos hoverInfo
217+ -> IO Maybe Maybe Range , [T. Text
218+ atPoint IdeOptions {} (HAR _ hf _ _ (kind :: HieKind hietype )) (DKMap dm km) env pos =
219+ listToMaybe <$> sequence (pointCommand hf pos hoverInfo)
218220 where
219221 -- Hover info for values/data
220- hoverInfo ast = (Just range, prettyNames ++ pTypes)
222+ hoverInfo :: HieAST hietype -> IO Maybe Range , [T. Text
223+ hoverInfo ast = do
224+ prettyNames <- mapM prettyName filteredNames
225+ pure (Just range, prettyNames ++ pTypes)
221226 where
227+ pTypes :: [T. Text
222228 pTypes
223229 | Prelude. length names == 1 = dropEnd1 $ map wrapHaskell prettyTypes
224230 | otherwise = map wrapHaskell prettyTypes
225231
232+ range :: Range
226233 range = realSrcSpanToRange $ nodeSpan ast
227234
235+ wrapHaskell :: T. Text-> T. Text
228236 wrapHaskell x = " \n ```haskell\n " <> x<> " \n ```\n "
237+
238+ info :: NodeInfo hietype
229239 info = nodeInfoH kind ast
240+
241+ names :: [(Identifier , IdentifierDetails hietype )]
230242 names = M. assocs $ nodeIdentifiers info
243+
231244 -- Check for evidence bindings
232245 isInternal :: (Identifier , IdentifierDetails a ) -> Bool
233246 isInternal (Right =
@@ -237,11 +250,12 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
237250 False
238251#endif
239252 isInternal (Left = False
253+
254+ filteredNames :: [(Identifier , IdentifierDetails hietype )]
240255 filteredNames = filter (not . isInternal) names
241- types = nodeType info
242- prettyNames :: [T. Text
243- prettyNames = map prettyName filteredNames
244- prettyName (Right = T. unlines $
256+
257+ prettyName :: (Either ModuleName Name , IdentifierDetails hietype ) -> IO T. Text
258+ prettyName (Right = pure $ T. unlines $
245259 wrapHaskell (printOutputable n <> maybe " " " :: " <> ) ((prettyType <$> identType dets) <|> maybeKind))
246260 : maybeToList (pretty (definedAt n) (prettyPackageName n))
247261 ++ catMaybes [ T. unlines . spanDocToMarkdown <$> lookupNameEnv dm n
@@ -251,21 +265,48 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
251265 pretty (Just define) Nothing = Just $ define <> " \n "
252266 pretty Nothing (Just pkgName) = Just $ pkgName <> " \n "
253267 pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> " \n "
254- prettyName (Left = printOutputable m
268+ prettyName (Left = packageNameForImportStatement m
255269
270+ prettyPackageName :: Name -> Maybe T. Text
256271 prettyPackageName n = do
257272 m <- nameModule_maybe n
273+ pkgTxt <- packageNameWithVersion m env
274+ pure $ " *(" <> pkgTxt <> " )*"
275+
276+ -- Return the module text itself and
277+ -- the package(with version) this `ModuleName` belongs to.
278+ packageNameForImportStatement :: ModuleName -> IO T. Text
279+ packageNameForImportStatement mod = do
280+ mpkg <- findImportedModule env mod :: IO Maybe Module )
281+ let moduleName = printOutputable mod
282+ case join $ traverse (flip packageNameWithVersion env) mpkg of
283+ Nothing -> pure moduleName
284+ Just pkgWithVersion -> pure $ moduleName <> " \n\n " <> pkgWithVersion
285+
286+ -- Return the package name and version of a module.
287+ -- For example, given module `Data.List`, it should return something like `base-4.x`.
288+ packageNameWithVersion :: Module -> HscEnv -> Maybe T. Text
289+ packageNameWithVersion m env = do
258290 let pid = moduleUnit m
259291 conf <- lookupUnit env pid
260292 let pkgName = T. pack $ unitPackageNameString conf
261293 version = T. pack $ showVersion (unitPackageVersion conf)
262- pure $ " *(" <> pkgName <> " -" <> version <> " )*"
294+ pure $ pkgName <> " -" <> version
295+
296+ -- Type info for the current node, it may contains several symbols
297+ -- for one range, like wildcard
298+ types :: [hietype ]
299+ types = nodeType info
263300
301+ prettyTypes :: [T. Text
264302 prettyTypes = map ((" _ :: " <> ) . prettyType) types
303+
304+ prettyType :: hietype -> T. Text
265305 prettyType t = case kind of
266306 HieFresh -> printOutputable t
267307 HieFromDisk full_file -> printOutputable $ hieTypeToIface $ recoverFullType t (hie_types full_file)
268308
309+ definedAt :: Name -> Maybe T. Text
269310 definedAt name =
270311 -- do not show "at <no location info>" and similar messages
271312 -- see the code of 'pprNameDefnLoc' for more information
0 commit comments