{-# LANGUAGE DataKinds #-}

module Unison.LSP.Formatting where

import Control.Lens hiding (List)
import Data.Set qualified as Set
import Language.LSP.Protocol.Lens
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Formatting
import Unison.Codebase.ProjectPath qualified as PP
import Unison.LSP.Conversions (lspToURange, uToLspRange)
import Unison.LSP.FileAnalysis (getFileAnalysis)
import Unison.LSP.FileAnalysis qualified as FileAnalysis
import Unison.LSP.Types
import Unison.Prelude

formatDocRequest :: Msg.TRequestMessage 'Msg.Method_TextDocumentFormatting -> (Either (Msg.TResponseError m) (Msg.MessageResult 'Msg.Method_TextDocumentFormatting) -> Lsp ()) -> Lsp ()
formatDocRequest :: forall {f :: MessageDirection} (m :: Method f 'Request).
TRequestMessage 'Method_TextDocumentFormatting
-> (Either
      (TResponseError m) (MessageResult 'Method_TextDocumentFormatting)
    -> Lsp ())
-> Lsp ()
formatDocRequest TRequestMessage 'Method_TextDocumentFormatting
m Either
  (TResponseError m) (MessageResult 'Method_TextDocumentFormatting)
-> Lsp ()
respond = do
  edits <- Uri -> Maybe (Set Range) -> Lsp [TextEdit]
formatDefs (TRequestMessage 'Method_TextDocumentFormatting
m TRequestMessage 'Method_TextDocumentFormatting
-> Getting Uri (TRequestMessage 'Method_TextDocumentFormatting) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> TRequestMessage 'Method_TextDocumentFormatting
-> Const Uri (TRequestMessage 'Method_TextDocumentFormatting)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentFormatting)
  DocumentFormattingParams
params ((DocumentFormattingParams -> Const Uri DocumentFormattingParams)
 -> TRequestMessage 'Method_TextDocumentFormatting
 -> Const Uri (TRequestMessage 'Method_TextDocumentFormatting))
-> ((Uri -> Const Uri Uri)
    -> DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentFormatting) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentFormattingParams -> Const Uri DocumentFormattingParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DocumentFormattingParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentFormattingParams -> Const Uri DocumentFormattingParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> DocumentFormattingParams
-> Const Uri DocumentFormattingParams
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) Maybe (Set Range)
forall a. Maybe a
Nothing
  respond . Right . InL $ edits

formatRangeRequest :: Msg.TRequestMessage 'Msg.Method_TextDocumentRangeFormatting -> (Either (Msg.TResponseError m) (Msg.MessageResult 'Msg.Method_TextDocumentRangeFormatting) -> Lsp ()) -> Lsp ()
formatRangeRequest :: forall {f :: MessageDirection} (m :: Method f 'Request).
TRequestMessage 'Method_TextDocumentRangeFormatting
-> (Either
      (TResponseError m)
      (MessageResult 'Method_TextDocumentRangeFormatting)
    -> Lsp ())
-> Lsp ()
formatRangeRequest TRequestMessage 'Method_TextDocumentRangeFormatting
m Either
  (TResponseError m)
  (MessageResult 'Method_TextDocumentRangeFormatting)
-> Lsp ()
respond = do
  let p :: DocumentRangeFormattingParams
p = TRequestMessage 'Method_TextDocumentRangeFormatting
m TRequestMessage 'Method_TextDocumentRangeFormatting
-> Getting
     DocumentRangeFormattingParams
     (TRequestMessage 'Method_TextDocumentRangeFormatting)
     DocumentRangeFormattingParams
-> DocumentRangeFormattingParams
forall s a. s -> Getting a s a -> a
^. Getting
  DocumentRangeFormattingParams
  (TRequestMessage 'Method_TextDocumentRangeFormatting)
  DocumentRangeFormattingParams
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentRangeFormatting)
  DocumentRangeFormattingParams
params
  edits <- Uri -> Maybe (Set Range) -> Lsp [TextEdit]
formatDefs (DocumentRangeFormattingParams
p DocumentRangeFormattingParams
-> Getting Uri DocumentRangeFormattingParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentRangeFormattingParams
-> Const Uri DocumentRangeFormattingParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DocumentRangeFormattingParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentRangeFormattingParams
 -> Const Uri DocumentRangeFormattingParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri DocumentRangeFormattingParams Uri
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) (Set Range -> Maybe (Set Range)
forall a. a -> Maybe a
Just (Set Range -> Maybe (Set Range))
-> (Range -> Set Range) -> Range -> Maybe (Set Range)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Set Range
forall a. a -> Set a
Set.singleton (Range -> Maybe (Set Range)) -> Range -> Maybe (Set Range)
forall a b. (a -> b) -> a -> b
$ DocumentRangeFormattingParams
p DocumentRangeFormattingParams
-> Getting Range DocumentRangeFormattingParams Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range DocumentRangeFormattingParams Range
forall s a. HasRange s a => Lens' s a
Lens' DocumentRangeFormattingParams Range
range)
  respond . Right . InL $ edits

-- | Format all definitions in a file.
formatDefs :: Uri -> Maybe (Set Range {- the ranges to format, if Nothing then format the whole file. -}) -> Lsp [TextEdit]
formatDefs :: Uri -> Maybe (Set Range) -> Lsp [TextEdit]
formatDefs Uri
fileUri Maybe (Set Range)
mayRangesToFormat =
  [TextEdit] -> Maybe [TextEdit] -> [TextEdit]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TextEdit] -> [TextEdit])
-> Lsp (Maybe [TextEdit]) -> Lsp [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Lsp [TextEdit] -> Lsp (Maybe [TextEdit])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    FileAnalysis {parsedFile = mayParsedFile, typecheckedFile = mayTypecheckedFile} <- Uri -> MaybeT Lsp FileAnalysis
forall (m :: * -> *). Lspish m => Uri -> MaybeT m FileAnalysis
getFileAnalysis Uri
fileUri
    pp <- lift getCurrentProjectPath
    Config {formattingWidth} <- lift getConfig
    MaybeT $
      Formatting.formatFile (\Maybe (UnisonFile Symbol Ann)
uf Maybe (TypecheckedUnisonFile Symbol Ann)
tf -> Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Lsp PrettyPrintEnvDecl
forall (m :: * -> *) a.
Lspish m =>
Maybe (UnisonFile Symbol a)
-> Maybe (TypecheckedUnisonFile Symbol a) -> m PrettyPrintEnvDecl
FileAnalysis.ppedForFileHelper Maybe (UnisonFile Symbol Ann)
uf Maybe (TypecheckedUnisonFile Symbol Ann)
tf) formattingWidth (pp ^. PP.absPath_) mayParsedFile mayTypecheckedFile (Set.map lspToURange <$> mayRangesToFormat)
        <&> (fmap . fmap) uTextReplacementToLSP
  where
    uTextReplacementToLSP :: Formatting.TextReplacement -> TextEdit
    uTextReplacementToLSP :: TextReplacement -> TextEdit
uTextReplacementToLSP (Formatting.TextReplacement Text
newText Range
range) = Range -> Text -> TextEdit
TextEdit (Range -> Range
uToLspRange Range
range) Text
newText