module Unison.Codebase.Editor.HandleInput.DebugFoldRanges (debugFoldRanges) where

import Control.Lens
import Control.Monad.Reader
import Data.Text qualified as Text
import Language.LSP.Protocol.Lens
import Language.LSP.Protocol.Types qualified as LSP
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase.Editor.HandleInput.FormatFile (TextReplacement (..))
import Unison.Codebase.Editor.HandleInput.FormatFile qualified as FormatFile
import Unison.Codebase.Editor.Output
import Unison.LSP.Conversions qualified as CV
import Unison.LSP.FoldingRange (foldingRangesForFile)
import Unison.Prelude
import Unison.Util.Range qualified as U

debugFoldRanges :: Cli ()
debugFoldRanges :: Cli ()
debugFoldRanges = do
  Cli.Env {Text -> IO LoadSourceResult
loadSource :: Text -> IO LoadSourceResult
$sel:loadSource:Env :: Env -> Text -> IO LoadSourceResult
loadSource} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (FilePath
filePath, Bool
_) <- Cli (FilePath, Bool)
Cli.expectLatestFile
  UnisonFile Symbol Ann
parsedFile <- Cli (UnisonFile Symbol Ann)
Cli.expectLatestParsedFile
  let foldingRanges :: [Range]
foldingRanges =
        UnisonFile Symbol Ann -> [FoldingRange]
foldingRangesForFile UnisonFile Symbol Ann
parsedFile
          [FoldingRange] -> ([FoldingRange] -> [Range]) -> [Range]
forall a b. a -> (a -> b) -> b
& (FoldingRange -> Range) -> [FoldingRange] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \FoldingRange
fr ->
                Position -> Position -> Range
LSP.Range
                  (UInt -> UInt -> Position
LSP.Position (FoldingRange
fr FoldingRange -> Getting UInt FoldingRange UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt FoldingRange UInt
forall s a. HasStartLine s a => Lens' s a
Lens' FoldingRange UInt
startLine) (UInt -> Maybe UInt -> UInt
forall a. a -> Maybe a -> a
fromMaybe UInt
0 (Maybe UInt -> UInt) -> Maybe UInt -> UInt
forall a b. (a -> b) -> a -> b
$ FoldingRange
fr FoldingRange
-> Getting (Maybe UInt) FoldingRange (Maybe UInt) -> Maybe UInt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe UInt) FoldingRange (Maybe UInt)
forall s a. HasStartCharacter s a => Lens' s a
Lens' FoldingRange (Maybe UInt)
startCharacter))
                  ( case (FoldingRange
fr FoldingRange
-> Getting (Maybe UInt) FoldingRange (Maybe UInt) -> Maybe UInt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe UInt) FoldingRange (Maybe UInt)
forall s a. HasEndCharacter s a => Lens' s a
Lens' FoldingRange (Maybe UInt)
endCharacter) of
                      Just UInt
c -> UInt -> UInt -> Position
LSP.Position (FoldingRange
fr FoldingRange -> Getting UInt FoldingRange UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt FoldingRange UInt
forall s a. HasEndLine s a => Lens' s a
Lens' FoldingRange UInt
endLine) UInt
c
                      -- If there's no end char specified, go all the way to the beginning of the next line
                      Maybe UInt
Nothing -> UInt -> UInt -> Position
LSP.Position ((FoldingRange
fr FoldingRange -> Getting UInt FoldingRange UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt FoldingRange UInt
forall s a. HasEndLine s a => Lens' s a
Lens' FoldingRange UInt
endLine) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) UInt
0
                  )
            )
  Text
sourceTxt <-
    IO LoadSourceResult -> Cli LoadSourceResult
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO LoadSourceResult
loadSource (FilePath -> Text
Text.pack FilePath
filePath)) Cli LoadSourceResult -> (LoadSourceResult -> Cli Text) -> Cli Text
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      LoadSourceResult
Cli.InvalidSourceNameError -> Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Output
InvalidSourceName FilePath
filePath
      LoadSourceResult
Cli.LoadError -> Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Output
SourceLoadFailed FilePath
filePath
      Cli.LoadSuccess Text
contents -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
contents
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> Output
AnnotatedFoldRanges (Text -> Output) -> Text -> Output
forall a b. (a -> b) -> a -> b
$ Text -> [Range] -> Text
annotateRanges Text
sourceTxt [Range]
foldingRanges

-- | Annotate the bounds of a range within text using 《 and 》.
--
-- Useful for checking that computed ranges make sense against the source text.
--
-- >>> annotateRanges "one\ntwo\nthree\nfour" [ LSP.Range (LSP.Position 1 0) (LSP.Position 2 3) ]
-- "one\n\12298two\nthr\12299ee\nfour"
annotateRanges :: Text -> [LSP.Range] -> Text
annotateRanges :: Text -> [Range] -> Text
annotateRanges Text
txt [Range]
ranges =
  let replacements :: [TextReplacement]
replacements =
        [Range]
ranges
          [Range] -> ([Range] -> [TextReplacement]) -> [TextReplacement]
forall a b. a -> (a -> b) -> b
& (Range -> [TextReplacement]) -> [Range] -> [TextReplacement]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
            ( \(LSP.Range Position
start Position
end) ->
                let startPos :: Pos
startPos = Position -> Pos
CV.lspToUPos Position
start
                    endPos :: Pos
endPos = Position -> Pos
CV.lspToUPos Position
end
                 in [ Text -> Range -> TextReplacement
TextReplacement Text
"《" (Pos -> Pos -> Range
U.Range Pos
startPos Pos
startPos),
                      Text -> Range -> TextReplacement
TextReplacement Text
"》" (Pos -> Pos -> Range
U.Range Pos
endPos Pos
endPos)
                    ]
            )
   in [TextReplacement] -> Text -> Text
FormatFile.applyTextReplacements [TextReplacement]
replacements Text
txt