Skip to content

Commit 9c87ef4

Browse files
jian-linjian-lin
committed
Format with ormolu
This basically changes indentation size from 4 to 2. Refs: #4703
1 parent f5a9858 commit 9c87ef4

File tree

2 files changed

+607
-607
lines changed

2 files changed

+607
-607
lines changed

‎plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs‎

Lines changed: 151 additions & 151 deletions
Original file line numberDiff line numberDiff line change
@@ -75,110 +75,110 @@ import Language.LSP.Protocol.Types (MarkupContent (MarkupCont
7575
data Log
7676

7777
instance Pretty Log where
78-
pretty = \case
78+
pretty = \case
7979

8080
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
8181
descriptor _recorder pluginId =
82-
(defaultPluginDescriptor pluginId "Provides signature help of something callable")
83-
{ Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider
84-
}
82+
(defaultPluginDescriptor pluginId "Provides signature help of something callable")
83+
{ Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider
84+
}
8585

8686
signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp
8787
signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken mSignatureHelpContext) = do
88-
nfp <- getNormalizedFilePathE uri
89-
results <- runIdeActionE "signatureHelp.ast" (shakeExtras ideState) $ do
90-
(HAR {hieAst, hieKind}, positionMapping) <- useWithStaleFastE GetHieAst nfp
91-
case fromCurrentPosition positionMapping position of
92-
Nothing -> pure []
93-
Just oldPosition -> do
94-
pure $
95-
extractInfoFromSmallestContainingFunctionApplicationAst
96-
oldPosition
97-
hieAst
98-
( \span hieAst -> do
99-
let functionNode = getLeftMostNode hieAst
100-
(functionName, functionTypes) <- getNodeNameAndTypes hieKind functionNode
101-
argumentNumber <- getArgumentNumber span hieAst
102-
Just (functionName, functionTypes, argumentNumber)
103-
)
104-
(docMap, argDocMap) <- runIdeActionE "signatureHelp.docMap" (shakeExtras ideState) $ do
105-
mResult <- ExceptT $ Right <$> useWithStaleFast GetDocMap nfp
106-
case mResult of
107-
Just (DKMap docMap _tyThingMap argDocMap, _positionMapping) -> pure (docMap, argDocMap)
108-
Nothing -> pure (mempty, mempty)
109-
case results of
110-
[(_functionName, [], _argumentNumber)] -> pure $ InR Null
111-
[(functionName, functionTypes, argumentNumber)] ->
112-
pure $ InL $ mkSignatureHelp mSignatureHelpContext docMap argDocMap (fromIntegral argumentNumber - 1) functionName functionTypes
113-
_ -> pure $ InR Null
88+
nfp <- getNormalizedFilePathE uri
89+
results <- runIdeActionE "signatureHelp.ast" (shakeExtras ideState) $ do
90+
(HAR {hieAst, hieKind}, positionMapping) <- useWithStaleFastE GetHieAst nfp
91+
case fromCurrentPosition positionMapping position of
92+
Nothing -> pure []
93+
Just oldPosition -> do
94+
pure $
95+
extractInfoFromSmallestContainingFunctionApplicationAst
96+
oldPosition
97+
hieAst
98+
( \span hieAst -> do
99+
let functionNode = getLeftMostNode hieAst
100+
(functionName, functionTypes) <- getNodeNameAndTypes hieKind functionNode
101+
argumentNumber <- getArgumentNumber span hieAst
102+
Just (functionName, functionTypes, argumentNumber)
103+
)
104+
(docMap, argDocMap) <- runIdeActionE "signatureHelp.docMap" (shakeExtras ideState) $ do
105+
mResult <- ExceptT $ Right <$> useWithStaleFast GetDocMap nfp
106+
case mResult of
107+
Just (DKMap docMap _tyThingMap argDocMap, _positionMapping) -> pure (docMap, argDocMap)
108+
Nothing -> pure (mempty, mempty)
109+
case results of
110+
[(_functionName, [], _argumentNumber)] -> pure $ InR Null
111+
[(functionName, functionTypes, argumentNumber)] ->
112+
pure $ InL $ mkSignatureHelp mSignatureHelpContext docMap argDocMap (fromIntegral argumentNumber - 1) functionName functionTypes
113+
_ -> pure $ InR Null
114114

115115
mkSignatureHelp :: Maybe SignatureHelpContext -> DocMap -> ArgDocMap -> UInt -> Name -> [Type] -> SignatureHelp
116116
mkSignatureHelp mSignatureHelpContext docMap argDocMap argumentNumber functionName functionTypes =
117-
SignatureHelp
118-
(mkSignatureInformation docMap argDocMap argumentNumber functionName <$> functionTypes)
119-
activeSignature
120-
(Just $ InL argumentNumber)
121-
where
122-
activeSignature = case mSignatureHelpContext of
123-
Just
124-
( SignatureHelpContext
125-
_triggerKind
126-
_triggerCharacter
127-
True
128-
(Just (SignatureHelp _signatures oldActivateSignature _activeParameter))
129-
) -> oldActivateSignature
130-
_ -> Just 0
117+
SignatureHelp
118+
(mkSignatureInformation docMap argDocMap argumentNumber functionName <$> functionTypes)
119+
activeSignature
120+
(Just $ InL argumentNumber)
121+
where
122+
activeSignature = case mSignatureHelpContext of
123+
Just
124+
( SignatureHelpContext
125+
_triggerKind
126+
_triggerCharacter
127+
True
128+
(Just (SignatureHelp _signatures oldActivateSignature _activeParameter))
129+
) -> oldActivateSignature
130+
_ -> Just 0
131131

132132
mkSignatureInformation :: DocMap -> ArgDocMap -> UInt -> Name -> Type -> SignatureInformation
133133
mkSignatureInformation docMap argDocMap argumentNumber functionName functionType =
134-
let functionNameLabelPrefix = printOutputableOneLine (ppr functionName) <> " :: "
135-
mFunctionDoc = case lookupNameEnv docMap functionName of
136-
Nothing -> Nothing
137-
Just spanDoc -> Just $ InR $ mkMarkdownDoc spanDoc
138-
thisArgDocMap = case lookupNameEnv argDocMap functionName of
139-
Nothing -> mempty
140-
Just thisArgDocMap' -> thisArgDocMap'
141-
in SignatureInformation
142-
(functionNameLabelPrefix <> printOutputableOneLine functionType)
143-
mFunctionDoc
144-
(Just $ mkArguments thisArgDocMap (fromIntegral $ T.length functionNameLabelPrefix) functionType)
145-
(Just $ InL argumentNumber)
134+
let functionNameLabelPrefix = printOutputableOneLine (ppr functionName) <> " :: "
135+
mFunctionDoc = case lookupNameEnv docMap functionName of
136+
Nothing -> Nothing
137+
Just spanDoc -> Just $ InR $ mkMarkdownDoc spanDoc
138+
thisArgDocMap = case lookupNameEnv argDocMap functionName of
139+
Nothing -> mempty
140+
Just thisArgDocMap' -> thisArgDocMap'
141+
in SignatureInformation
142+
(functionNameLabelPrefix <> printOutputableOneLine functionType)
143+
mFunctionDoc
144+
(Just $ mkArguments thisArgDocMap (fromIntegral $ T.length functionNameLabelPrefix) functionType)
145+
(Just $ InL argumentNumber)
146146

147147
mkArguments :: IntMap SpanDoc -> UInt -> Type -> [ParameterInformation]
148148
mkArguments thisArgDocMap offset functionType =
149-
[ ParameterInformation (InR range) mArgDoc
150-
| (argIndex, range) <- zip [0..] (bimap (+offset) (+offset) <$> findArgumentRanges functionType)
151-
, let mArgDoc = case IntMap.lookup argIndex thisArgDocMap of
152-
Nothing -> Nothing
153-
Just spanDoc -> Just $ InR $ mkMarkdownDoc $ removeUris spanDoc
154-
]
155-
where
156-
-- we already show uris in the function doc, no need to duplicate them in the arg doc
157-
removeUris (SpanDocString docs _uris) = SpanDocString docs emptyUris
158-
removeUris (SpanDocText docs _uris) = SpanDocText docs emptyUris
149+
[ ParameterInformation (InR range) mArgDoc
150+
| (argIndex, range) <- zip [0 ..] (bimap (+ offset) (+ offset) <$> findArgumentRanges functionType),
151+
let mArgDoc = case IntMap.lookup argIndex thisArgDocMap of
152+
Nothing -> Nothing
153+
Just spanDoc -> Just $ InR $ mkMarkdownDoc $ removeUris spanDoc
154+
]
155+
where
156+
-- we already show uris in the function doc, no need to duplicate them in the arg doc
157+
removeUris (SpanDocString docs _uris) = SpanDocString docs emptyUris
158+
removeUris (SpanDocText docs _uris) = SpanDocText docs emptyUris
159159

160-
emptyUris = SpanDocUris Nothing Nothing
160+
emptyUris = SpanDocUris Nothing Nothing
161161

162162
mkMarkdownDoc :: SpanDoc -> MarkupContent
163163
mkMarkdownDoc = spanDocToMarkdown >>> T.unlines >>> MarkupContent MarkupKind_Markdown
164164

165165
findArgumentRanges :: Type -> [(UInt, UInt)]
166166
findArgumentRanges functionType =
167-
let functionTypeString = printOutputableOneLine functionType
168-
functionTypeStringLength = fromIntegral $ T.length functionTypeString
169-
splitFunctionTypes = filter notTypeConstraint $ splitFunTysIgnoringForAll functionType
170-
splitFunctionTypeStrings = printOutputableOneLine . fst <$> splitFunctionTypes
171-
-- reverse to avoid matching "a" of "forall a" in "forall a. a -> a"
172-
reversedRanges =
173-
drop 1 $ -- do not need the range of the result (last) type
174-
findArgumentStringRanges
175-
0
176-
(T.reverse functionTypeString)
177-
(T.reverse <$> reverse splitFunctionTypeStrings)
178-
in reverse $ modifyRange functionTypeStringLength <$> reversedRanges
179-
where
180-
modifyRange functionTypeStringLength (start, end) =
181-
(functionTypeStringLength - end, functionTypeStringLength - start)
167+
let functionTypeString = printOutputableOneLine functionType
168+
functionTypeStringLength = fromIntegral $ T.length functionTypeString
169+
splitFunctionTypes = filter notTypeConstraint $ splitFunTysIgnoringForAll functionType
170+
splitFunctionTypeStrings = printOutputableOneLine . fst <$> splitFunctionTypes
171+
-- reverse to avoid matching "a" of "forall a" in "forall a. a -> a"
172+
reversedRanges =
173+
drop 1 $ -- do not need the range of the result (last) type
174+
findArgumentStringRanges
175+
0
176+
(T.reverse functionTypeString)
177+
(T.reverse <$> reverse splitFunctionTypeStrings)
178+
in reverse $ modifyRange functionTypeStringLength <$> reversedRanges
179+
where
180+
modifyRange functionTypeStringLength (start, end) =
181+
(functionTypeStringLength - end, functionTypeStringLength - start)
182182

183183
{-
184184
The implemented method uses both structured type and unstructured type string.
@@ -203,106 +203,106 @@ Some tricky cases are as follows:
203203
-}
204204
findArgumentStringRanges :: UInt -> Text -> [Text] -> [(UInt, UInt)]
205205
findArgumentStringRanges _totalPrefixLength _functionTypeString [] = []
206-
findArgumentStringRanges totalPrefixLength functionTypeString (argumentTypeString:restArgumentTypeStrings) =
207-
let (prefix, match) = T.breakOn argumentTypeString functionTypeString
208-
prefixLength = fromIntegral $ T.length prefix
209-
argumentTypeStringLength = fromIntegral $ T.length argumentTypeString
210-
start = totalPrefixLength + prefixLength
211-
in (start, start + argumentTypeStringLength)
212-
: findArgumentStringRanges
213-
(totalPrefixLength + prefixLength + argumentTypeStringLength)
214-
(T.drop (fromIntegral argumentTypeStringLength) match)
215-
restArgumentTypeStrings
206+
findArgumentStringRanges totalPrefixLength functionTypeString (argumentTypeString : restArgumentTypeStrings) =
207+
let (prefix, match) = T.breakOn argumentTypeString functionTypeString
208+
prefixLength = fromIntegral $ T.length prefix
209+
argumentTypeStringLength = fromIntegral $ T.length argumentTypeString
210+
start = totalPrefixLength + prefixLength
211+
in (start, start + argumentTypeStringLength)
212+
: findArgumentStringRanges
213+
(totalPrefixLength + prefixLength + argumentTypeStringLength)
214+
(T.drop (fromIntegral argumentTypeStringLength) match)
215+
restArgumentTypeStrings
216216

217217
-- similar to 'splitFunTys' but
218218
-- 1) the result (last) type is included and
219219
-- 2) toplevel foralls are ignored
220220
splitFunTysIgnoringForAll :: Type -> [(Type, Maybe FunTyFlag)]
221221
splitFunTysIgnoringForAll ty = case ty & dropForAlls & splitFunTy_maybe of
222-
Just (funTyFlag, _mult, argumentType, resultType) ->
223-
(argumentType, Just funTyFlag) : splitFunTysIgnoringForAll resultType
224-
Nothing -> [(ty, Nothing)]
222+
Just (funTyFlag, _mult, argumentType, resultType) ->
223+
(argumentType, Just funTyFlag) : splitFunTysIgnoringForAll resultType
224+
Nothing -> [(ty, Nothing)]
225225

226226
notTypeConstraint :: (Type, Maybe FunTyFlag) -> Bool
227227
notTypeConstraint (_type, Just FTF_T_T) = True
228228
notTypeConstraint (_type, Nothing) = True
229229
notTypeConstraint _ = False
230230

231231
extractInfoFromSmallestContainingFunctionApplicationAst ::
232-
Position -> HieASTs a -> (RealSrcSpan -> HieAST a -> Maybe b) -> [b]
232+
Position -> HieASTs a -> (RealSrcSpan -> HieAST a -> Maybe b) -> [b]
233233
extractInfoFromSmallestContainingFunctionApplicationAst position hieAsts extractInfo =
234-
M.elems $ flip M.mapMaybeWithKey (getAsts hieAsts) $ \hiePath hieAst ->
235-
smallestContainingSatisfying (positionToSpan hiePath position) (nodeHasAnnotation ("HsApp", "HsExpr")) hieAst
236-
>>= extractInfo (positionToSpan hiePath position)
237-
where
238-
positionToSpan hiePath position =
239-
let loc = mkLoc hiePath position in mkRealSrcSpan loc loc
240-
mkLoc (LexicalFastString hiePath) (Position line character) =
241-
mkRealSrcLoc hiePath (fromIntegral line + 1) (fromIntegral character + 1)
234+
M.elems $ flip M.mapMaybeWithKey (getAsts hieAsts) $ \hiePath hieAst ->
235+
smallestContainingSatisfying (positionToSpan hiePath position) (nodeHasAnnotation ("HsApp", "HsExpr")) hieAst
236+
>>= extractInfo (positionToSpan hiePath position)
237+
where
238+
positionToSpan hiePath position =
239+
let loc = mkLoc hiePath position in mkRealSrcSpan loc loc
240+
mkLoc (LexicalFastString hiePath) (Position line character) =
241+
mkRealSrcLoc hiePath (fromIntegral line + 1) (fromIntegral character + 1)
242242

243243
type Annotation = (FastStringCompat, FastStringCompat)
244244

245245
nodeHasAnnotation :: Annotation -> HieAST a -> Bool
246246
nodeHasAnnotation annotation hieAst = case sourceNodeInfo hieAst of
247-
Nothing -> False
248-
Just nodeInfo -> isAnnotationInNodeInfo annotation nodeInfo
247+
Nothing -> False
248+
Just nodeInfo -> isAnnotationInNodeInfo annotation nodeInfo
249249

250250
getLeftMostNode :: HieAST a -> HieAST a
251251
getLeftMostNode thisNode =
252-
case nodeChildren thisNode of
253-
[] -> thisNode
254-
leftChild: _ -> getLeftMostNode leftChild
252+
case nodeChildren thisNode of
253+
[] -> thisNode
254+
leftChild : _ -> getLeftMostNode leftChild
255255

256256
getNodeNameAndTypes :: HieKind a -> HieAST a -> Maybe (Name, [Type])
257257
getNodeNameAndTypes hieKind hieAst =
258-
if nodeHasAnnotation ("HsVar", "HsExpr") hieAst
259-
then case hieAst & getSourceNodeIds & M.filter isUse & M.assocs of
260-
[(identifier, identifierDetails)] ->
261-
case extractName identifier of
262-
Nothing -> Nothing
263-
Just name ->
264-
let mTypeOfName = identType identifierDetails
265-
typesOfNode = case sourceNodeInfo hieAst of
266-
Nothing -> []
267-
Just nodeInfo -> nodeType nodeInfo
268-
allTypes = case mTypeOfName of
269-
Nothing -> typesOfNode
270-
Just typeOfName -> typeOfName : filter (isDifferentType typeOfName) typesOfNode
271-
in Just (name, filterCoreTypes allTypes)
272-
[] -> Nothing
273-
_ -> Nothing -- seems impossible
274-
else Nothing
275-
where
276-
extractName = rightToMaybe
258+
if nodeHasAnnotation ("HsVar", "HsExpr") hieAst
259+
then case hieAst & getSourceNodeIds & M.filter isUse & M.assocs of
260+
[(identifier, identifierDetails)] ->
261+
case extractName identifier of
262+
Nothing -> Nothing
263+
Just name ->
264+
let mTypeOfName = identType identifierDetails
265+
typesOfNode = case sourceNodeInfo hieAst of
266+
Nothing -> []
267+
Just nodeInfo -> nodeType nodeInfo
268+
allTypes = case mTypeOfName of
269+
Nothing -> typesOfNode
270+
Just typeOfName -> typeOfName : filter (isDifferentType typeOfName) typesOfNode
271+
in Just (name, filterCoreTypes allTypes)
272+
[] -> Nothing
273+
_ -> Nothing -- seems impossible
274+
else Nothing
275+
where
276+
extractName = rightToMaybe
277277

278-
isDifferentType type1 type2 = case hieKind of
279-
HieFresh -> deBruijnize type1 /= deBruijnize type2
280-
HieFromDisk {} -> type1 /= type2
278+
isDifferentType type1 type2 = case hieKind of
279+
HieFresh -> deBruijnize type1 /= deBruijnize type2
280+
HieFromDisk {} -> type1 /= type2
281281

282-
filterCoreTypes types = case hieKind of
283-
HieFresh -> types
284-
-- ignore this case since this only happens before we finish startup
285-
HieFromDisk {} -> []
282+
filterCoreTypes types = case hieKind of
283+
HieFresh -> types
284+
-- ignore this case since this only happens before we finish startup
285+
HieFromDisk {} -> []
286286

287287
isUse :: IdentifierDetails a -> Bool
288288
isUse = identInfo >>> S.member Use
289289

290290
-- Just 1 means the first argument
291291
getArgumentNumber :: RealSrcSpan -> HieAST a -> Maybe Integer
292292
getArgumentNumber span hieAst
293-
| nodeHasAnnotation ("HsApp", "HsExpr") hieAst =
294-
case nodeChildren hieAst of
295-
[leftChild, _] ->
296-
if span `isRealSubspanOf` nodeSpan leftChild
297-
then Nothing
298-
else getArgumentNumber span leftChild >>= \argumentNumber -> Just (argumentNumber + 1)
299-
_ -> Nothing -- impossible
300-
| nodeHasAnnotation ("HsAppType", "HsExpr") hieAst =
301-
case nodeChildren hieAst of
302-
[leftChild, _] -> getArgumentNumber span leftChild
303-
_ -> Nothing -- impossible
304-
| otherwise =
305-
case nodeChildren hieAst of
306-
[] -> Just 0 -- the function is found
307-
[child] -> getArgumentNumber span child -- ignore irrelevant nodes
308-
_ -> Nothing
293+
| nodeHasAnnotation ("HsApp", "HsExpr") hieAst =
294+
case nodeChildren hieAst of
295+
[leftChild, _] ->
296+
if span `isRealSubspanOf` nodeSpan leftChild
297+
then Nothing
298+
else getArgumentNumber span leftChild >>= \argumentNumber -> Just (argumentNumber + 1)
299+
_ -> Nothing -- impossible
300+
| nodeHasAnnotation ("HsAppType", "HsExpr") hieAst =
301+
case nodeChildren hieAst of
302+
[leftChild, _] -> getArgumentNumber span leftChild
303+
_ -> Nothing -- impossible
304+
| otherwise =
305+
case nodeChildren hieAst of
306+
[] -> Just 0 -- the function is found
307+
[child] -> getArgumentNumber span child -- ignore irrelevant nodes
308+
_ -> Nothing

0 commit comments

Comments
 (0)