{-# LANGUAGE DataKinds #-}

module Unison.LSP.FoldingRange
  ( foldingRangeRequest,
    foldingRangesForFile,
  )
where

import Control.Lens hiding (List)
import Data.Map qualified as Map
import Data.Text qualified as Text
import Language.LSP.Protocol.Lens hiding (id, to)
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.DataDeclaration qualified as DD
import Unison.LSP.Conversions (annToRange)
import Unison.LSP.FileAnalysis (getFileAnalysis)
import Unison.LSP.Types
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Symbol (Symbol)
import Unison.UnisonFile (UnisonFile (..))
import Unison.UnisonFile qualified as UF
import Unison.Var qualified as Var

foldingRangeRequest :: Msg.TRequestMessage 'Msg.Method_TextDocumentFoldingRange -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentFoldingRange) -> Lsp ()) -> Lsp ()
foldingRangeRequest :: TRequestMessage 'Method_TextDocumentFoldingRange
-> (Either
      ResponseError (MessageResult 'Method_TextDocumentFoldingRange)
    -> Lsp ())
-> Lsp ()
foldingRangeRequest TRequestMessage 'Method_TextDocumentFoldingRange
m Either
  ResponseError (MessageResult 'Method_TextDocumentFoldingRange)
-> Lsp ()
respond = do
  let fileUri :: Uri
fileUri = TRequestMessage 'Method_TextDocumentFoldingRange
m TRequestMessage 'Method_TextDocumentFoldingRange
-> Getting
     Uri (TRequestMessage 'Method_TextDocumentFoldingRange) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (FoldingRangeParams -> Const Uri FoldingRangeParams)
-> TRequestMessage 'Method_TextDocumentFoldingRange
-> Const Uri (TRequestMessage 'Method_TextDocumentFoldingRange)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentFoldingRange)
  FoldingRangeParams
params ((FoldingRangeParams -> Const Uri FoldingRangeParams)
 -> TRequestMessage 'Method_TextDocumentFoldingRange
 -> Const Uri (TRequestMessage 'Method_TextDocumentFoldingRange))
-> ((Uri -> Const Uri Uri)
    -> FoldingRangeParams -> Const Uri FoldingRangeParams)
-> Getting
     Uri (TRequestMessage 'Method_TextDocumentFoldingRange) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> FoldingRangeParams -> Const Uri FoldingRangeParams
forall s a. HasTextDocument s a => Lens' s a
Lens' FoldingRangeParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> FoldingRangeParams -> Const Uri FoldingRangeParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> FoldingRangeParams
-> Const Uri FoldingRangeParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
  [FoldingRange]
foldRanges <-
    [FoldingRange] -> Maybe [FoldingRange] -> [FoldingRange]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FoldingRange] -> [FoldingRange])
-> Lsp (Maybe [FoldingRange]) -> Lsp [FoldingRange]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Lsp [FoldingRange] -> Lsp (Maybe [FoldingRange])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      FileAnalysis {$sel:parsedFile:FileAnalysis :: FileAnalysis -> Maybe (UnisonFile Symbol Ann)
parsedFile = Maybe (UnisonFile Symbol Ann)
mayParsedFile} <- Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis Uri
fileUri
      UnisonFile Symbol Ann
parsedFile <- Maybe (UnisonFile Symbol Ann) -> MaybeT Lsp (UnisonFile Symbol Ann)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe Maybe (UnisonFile Symbol Ann)
mayParsedFile
      pure $ UnisonFile Symbol Ann -> [FoldingRange]
foldingRangesForFile UnisonFile Symbol Ann
parsedFile
  Either ResponseError ([FoldingRange] |? Null) -> Lsp ()
Either
  ResponseError (MessageResult 'Method_TextDocumentFoldingRange)
-> Lsp ()
respond (Either ResponseError ([FoldingRange] |? Null) -> Lsp ())
-> ([FoldingRange]
    -> Either ResponseError ([FoldingRange] |? Null))
-> [FoldingRange]
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FoldingRange] |? Null)
-> Either ResponseError ([FoldingRange] |? Null)
forall a b. b -> Either a b
Right (([FoldingRange] |? Null)
 -> Either ResponseError ([FoldingRange] |? Null))
-> ([FoldingRange] -> [FoldingRange] |? Null)
-> [FoldingRange]
-> Either ResponseError ([FoldingRange] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FoldingRange] -> [FoldingRange] |? Null
forall a b. a -> a |? b
InL ([FoldingRange] -> Lsp ()) -> [FoldingRange] -> Lsp ()
forall a b. (a -> b) -> a -> b
$ [FoldingRange]
foldRanges

-- | Return a folding range for each top-level definition
foldingRangesForFile :: UF.UnisonFile Symbol Ann -> [FoldingRange]
foldingRangesForFile :: UnisonFile Symbol Ann -> [FoldingRange]
foldingRangesForFile UnisonFileId {Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
dataDeclarationsId :: Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
$sel:dataDeclarationsId:UnisonFileId :: forall v a.
UnisonFile v a -> Map v (TypeReferenceId, DataDeclaration v a)
dataDeclarationsId, Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
effectDeclarationsId :: Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
$sel:effectDeclarationsId:UnisonFileId :: forall v a.
UnisonFile v a -> Map v (TypeReferenceId, EffectDeclaration v a)
effectDeclarationsId, Map Symbol (Ann, Term Symbol Ann)
terms :: Map Symbol (Ann, Term Symbol Ann)
$sel:terms:UnisonFileId :: forall v a. UnisonFile v a -> Map v (a, Term v a)
terms, Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
watches :: Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
$sel:watches:UnisonFileId :: forall v a. UnisonFile v a -> Map WatchKind [(v, a, Term v a)]
watches} =
  let dataFolds :: [(Maybe Symbol, Ann)]
dataFolds =
        Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
dataDeclarationsId
          Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> (Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
    -> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))])
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> ([(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
    -> [(Maybe Symbol, Ann)])
-> [(Maybe Symbol, Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))
 -> (Maybe Symbol, Ann))
-> [(Symbol, (TypeReferenceId, DataDeclaration Symbol Ann))]
-> [(Maybe Symbol, Ann)]
forall a b. (a -> b) -> [a] -> [b]
map \(Symbol
sym, (TypeReferenceId
_typ, DataDeclaration Symbol Ann
decl)) -> (Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
sym, DataDeclaration Symbol Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration Symbol Ann
decl)
      abilityFolds :: [(Maybe Symbol, Ann)]
abilityFolds =
        Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
effectDeclarationsId
          Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> (Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
    -> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))])
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
-> ([(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
    -> [(Maybe Symbol, Ann)])
-> [(Maybe Symbol, Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))
 -> (Maybe Symbol, Ann))
-> [(Symbol, (TypeReferenceId, EffectDeclaration Symbol Ann))]
-> [(Maybe Symbol, Ann)]
forall a b. (a -> b) -> [a] -> [b]
map \(Symbol
sym, (TypeReferenceId
_typ, EffectDeclaration Symbol Ann
decl)) -> (Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
sym, DataDeclaration Symbol Ann -> Ann
forall v a. DataDeclaration v a -> a
DD.annotation (DataDeclaration Symbol Ann -> Ann)
-> (EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> EffectDeclaration Symbol Ann
-> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl (EffectDeclaration Symbol Ann -> Ann)
-> EffectDeclaration Symbol Ann -> Ann
forall a b. (a -> b) -> a -> b
$ EffectDeclaration Symbol Ann
decl)
      termFolds :: [(Maybe Symbol, Ann)]
termFolds = Map Symbol (Ann, Term Symbol Ann)
terms Map Symbol (Ann, Term Symbol Ann)
-> (Map Symbol (Ann, Term Symbol Ann)
    -> [(Symbol, (Ann, Term Symbol Ann))])
-> [(Symbol, (Ann, Term Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map Symbol (Ann, Term Symbol Ann)
-> [(Symbol, (Ann, Term Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList [(Symbol, (Ann, Term Symbol Ann))]
-> ([(Symbol, (Ann, Term Symbol Ann))] -> [(Maybe Symbol, Ann)])
-> [(Maybe Symbol, Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, (Ann, Term Symbol Ann)) -> (Maybe Symbol, Ann))
-> [(Symbol, (Ann, Term Symbol Ann))] -> [(Maybe Symbol, Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Symbol
sym, (Ann
ann, Term Symbol Ann
_trm)) -> (Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
sym, Ann
ann)
      watchFolds :: [(Maybe Symbol, Ann)]
watchFolds =
        Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
watches
          Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
-> (Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
    -> [(Symbol, Ann, Term Symbol Ann)])
-> [(Symbol, Ann, Term Symbol Ann)]
forall a b. a -> (a -> b) -> b
& Map WatchKind [(Symbol, Ann, Term Symbol Ann)]
-> [(Symbol, Ann, Term Symbol Ann)]
forall m. Monoid m => Map WatchKind m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          [(Symbol, Ann, Term Symbol Ann)]
-> ([(Symbol, Ann, Term Symbol Ann)] -> [(Maybe Symbol, Ann)])
-> [(Maybe Symbol, Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, Ann, Term Symbol Ann) -> (Maybe Symbol, Ann))
-> [(Symbol, Ann, Term Symbol Ann)] -> [(Maybe Symbol, Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(Symbol
_sym, Ann
ann, Term Symbol Ann
_trm) ->
                -- We don't use the symbol here because watch symbols are often auto-generated
                -- and ugly.
                (Maybe Symbol
forall a. Maybe a
Nothing, Ann
ann)
            )
      folds :: [(Maybe Symbol, Ann)]
folds =
        [(Maybe Symbol, Ann)]
dataFolds [(Maybe Symbol, Ann)]
-> [(Maybe Symbol, Ann)] -> [(Maybe Symbol, Ann)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe Symbol, Ann)]
abilityFolds [(Maybe Symbol, Ann)]
-> [(Maybe Symbol, Ann)] -> [(Maybe Symbol, Ann)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe Symbol, Ann)]
termFolds [(Maybe Symbol, Ann)]
-> [(Maybe Symbol, Ann)] -> [(Maybe Symbol, Ann)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe Symbol, Ann)]
watchFolds
      ranges :: [(Maybe Text, Range)]
ranges =
        [(Maybe Symbol, Ann)]
folds
          [(Maybe Symbol, Ann)]
-> ([(Maybe Symbol, Ann)] -> [(Maybe Text, Range)])
-> [(Maybe Text, Range)]
forall a b. a -> (a -> b) -> b
& ((Maybe Symbol, Ann) -> Maybe (Maybe Text, Range))
-> [(Maybe Symbol, Ann)] -> [(Maybe Text, Range)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(Maybe Symbol
sym, Ann
range) ->
            (WatchKind -> Text
Text.pack (WatchKind -> Text) -> (Symbol -> WatchKind) -> Symbol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> WatchKind
forall v. Var v => v -> WatchKind
Var.nameStr (Symbol -> Text) -> Maybe Symbol -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Symbol
sym,) (Range -> (Maybe Text, Range))
-> Maybe Range -> Maybe (Maybe Text, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ann -> Maybe Range
annToRange Ann
range
   in [(Maybe Text, Range)]
ranges [(Maybe Text, Range)]
-> ((Maybe Text, Range) -> FoldingRange) -> [FoldingRange]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe Text
maySym, Range
r) ->
        FoldingRange
          { $sel:_startLine:FoldingRange :: UInt
_startLine = Range
r Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasStart s a => Lens' s a
Lens' Range Position
start ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
line,
            $sel:_startCharacter:FoldingRange :: Maybe UInt
_startCharacter = UInt -> Maybe UInt
forall a. a -> Maybe a
Just (Range
r Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasStart s a => Lens' s a
Lens' Range Position
start ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
character),
            $sel:_endLine:FoldingRange :: UInt
_endLine = Range
r Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
end ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
line,
            $sel:_endCharacter:FoldingRange :: Maybe UInt
_endCharacter = UInt -> Maybe UInt
forall a. a -> Maybe a
Just (Range
r Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
end ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
character),
            $sel:_kind:FoldingRange :: Maybe FoldingRangeKind
_kind = FoldingRangeKind -> Maybe FoldingRangeKind
forall a. a -> Maybe a
Just FoldingRangeKind
FoldingRangeKind_Region,
            $sel:_collapsedText:FoldingRange :: Maybe Text
_collapsedText = Maybe Text
maySym
          }