Skip to content

Commit

Permalink
adds format in place
Browse files Browse the repository at this point in the history
roryc89 committed Nov 25, 2024

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature.
1 parent 48f96dc commit d56fe72
Showing 2 changed files with 47 additions and 12 deletions.
34 changes: 24 additions & 10 deletions src/Language/PureScript/Lsp/Handlers/Format.hs
Original file line number Diff line number Diff line change
@@ -4,24 +4,38 @@ import Control.Lens ((^.))
import Language.LSP.Protocol.Lens qualified as LSP
import Language.LSP.Protocol.Message qualified as Message
import Language.LSP.Protocol.Types qualified as Types
import Language.LSP.Server (getConfig)
import Language.LSP.Server qualified as Server
import Language.PureScript.Lsp.Imports (parseImportsFromFile, printImports)
import Language.PureScript.Lsp.Log (warnLsp)
import Language.PureScript.Lsp.Log (debugLsp, warnLsp)
import Language.PureScript.Lsp.Monad (HandlerM)
import Language.PureScript.Lsp.ReadFile (lspReadFileText)
import Language.PureScript.Lsp.ServerConfig (Formatter (..), ServerConfig (formatter))
import Protolude
import System.Process (readProcess)
import Data.String qualified as S

formatHandler :: Server.Handlers HandlerM
formatHandler = Server.requestHandler Message.SMethod_TextDocumentFormatting $ \req res -> do
let uri = req ^. LSP.params . LSP.textDocument . LSP.uri
normalizedUri = Types.toNormalizedUri uri
parsedImportsRes <- parseImportsFromFile normalizedUri
contents <- case parsedImportsRes of
Left err -> do
warnLsp $ "Failed to parse imports from file: " <> err
lspReadFileText $ Types.toNormalizedUri uri
Right imoprts -> pure $ printImports imoprts

formatted <- liftIO $ readProcess "purs-tidy" ["format"] (toS contents)
res $ Right $ Types.InL [Types.TextEdit (Types.Range (Types.Position 0 0) (Types.Position 100000 0)) (toS formatted)]
filePath = Types.uriToFilePath uri
debugLsp $ "Formatting file: " <> show filePath
config <- getConfig
case (formatter config, filePath) of
(PursTidyFormatInPlace, Just fp) -> do
void $ liftIO $ readProcess "purs-tidy" ["format-in-place"] fp
res $ Right $ Types.InR Types.Null
(PursTidyFormatInPlace, Nothing) -> do
res $ Left $ Message.TResponseError (Types.InR Types.ErrorCodes_InternalError) "File path not found" Nothing
(PursTidy, _) -> do
parsedImportsRes <- parseImportsFromFile normalizedUri
contents <- case parsedImportsRes of
Left err -> do
warnLsp $ "Failed to parse imports from file: " <> err
lspReadFileText $ Types.toNormalizedUri uri
Right imports -> pure $ printImports imports
formatted <- liftIO $ readProcess "purs-tidy" ["format"] (toS contents)
let lines' = toEnum $ length $ S.lines formatted
res $ Right $ Types.InL [Types.TextEdit (Types.Range (Types.Position 0 0) (Types.Position (lines' + 1) 0)) (toS formatted)]
_ -> res $ Left $ Message.TResponseError (Types.InR Types.ErrorCodes_InvalidParams) "No formatter set" Nothing
25 changes: 23 additions & 2 deletions src/Language/PureScript/Lsp/ServerConfig.hs
Original file line number Diff line number Diff line change
@@ -2,18 +2,21 @@

module Language.PureScript.Lsp.ServerConfig where

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson (FromJSON, ToJSON, fromJSON)
import Language.LSP.Protocol.Types (TraceValue (..))
import Language.LSP.Server (MonadLsp, getConfig, setConfig)
import Language.PureScript.Lsp.LogLevel (LspLogLevel (..))
import Protolude
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as AT

data ServerConfig = ServerConfig
{ outputPath :: FilePath,
globs :: [FilePath],
inputSrcFromFile :: Maybe FilePath,
logLevel :: LspLogLevel,
traceValue :: Maybe TraceValue,
formatter :: Formatter,
maxTypeLength :: Maybe Int,
maxCompletions :: Maybe Int,
maxFilesInCache :: Maybe Int,
@@ -31,6 +34,7 @@ defaultConfig outputPath =
inputSrcFromFile = Nothing,
logLevel = LogAll,
traceValue = Nothing,
formatter = PursTidy,
maxTypeLength = Just defaultMaxTypeLength,
maxCompletions = Just defaultMaxCompletions,
maxFilesInCache = Just defaultMaxFilesInCache,
@@ -67,4 +71,21 @@ getMaxFilesInCache =


getInferExpressions :: (MonadLsp ServerConfig m) => m Bool
getInferExpressions = inferExpressions <$> getConfig
getInferExpressions = inferExpressions <$> getConfig


data Formatter = NoFormatter | PursTidy | PursTidyFormatInPlace
deriving (Show, Eq)

instance FromJSON Formatter where
parseJSON v = case v of
A.String "none" -> pure NoFormatter
A.String "purs-tidy" -> pure PursTidy
A.String "purs-tidy-format-in-place" -> pure PursTidyFormatInPlace
_ -> AT.typeMismatch "String" v

instance ToJSON Formatter where
toJSON = \case
NoFormatter -> A.String "none"
PursTidy -> A.String "purs-tidy"
PursTidyFormatInPlace -> A.String "purs-tidy-format-in-place"

0 comments on commit d56fe72

Please sign in to comment.