-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
127 lines (117 loc) · 5.3 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Parser
import Language.LSP.Types
import Language.LSP.Server
import Language.LSP.Diagnostics
import Control.Monad.IO.Class
import System.Directory (findExecutable, doesFileExist, removeFile)
import System.Environment (getArgs, getEnv, getEnvironment)
import System.Process.Typed (readProcessStdout)
import Data.String (fromString)
import Data.ByteString.Char8 as B (unpack)
import Data.ByteString.Lazy as L (toStrict)
import Data.Either (rights, fromRight)
import Data.Map as M (insert)
import Data.SortedList as SL (toSortedList)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Control.Exception (catch, IOException)
import Text.Parsec.Prim (runParser)
import Network.URI
import System.IO.Temp (getCanonicalTemporaryDirectory)
import System.Random
import System.FilePath ((</>), takeExtension, dropExtension, takeFileName)
import System.IO
norminette :: FilePath -> IO [Diagnostic]
norminette path = do
(_, output) <- readProcessStdout (fromString $ "norminette " ++ path)
let either = map convertToDiagnostic <$> runParser interpret () "" (L.toStrict output)
return $ fromRight [] either
writeTempFile :: String -- file name template
-> T.Text -- data to store
-> IO FilePath
writeTempFile path txt = do
dir <- getCanonicalTemporaryDirectory
gen <- newStdGen
let infiniteList = randomRs ('0','9') gen
catch (createFile dir infiniteList) $
let newList = drop 8 infiniteList in
(const (createFile dir newList):: IOException -> IO [Char])
where createFile :: FilePath -> [Char] -> IO [Char]
createFile dir list = do
let iD = take 8 list
suffix = takeExtension path
prefix = dropExtension . takeFileName $ path
name = dir </> (prefix <> iD <> suffix)
notProceed <- doesFileExist name
if notProceed then createFile dir (drop 8 list) else do
TIO.writeFile name txt
return name
handlers :: Handlers (LspM ())
handlers = mconcat
[
notificationHandler STextDocumentDidOpen $ \_not -> do
let NotificationMessage _ _ params = _not
DidOpenTextDocumentParams item = params
TextDocumentItem (Uri uri) _ version _ = item
norminetteResult <- liftIO . norminette . getPath $ T.unpack uri
let diagnosticMap = M.insert Nothing (SL.toSortedList norminetteResult) mempty
publishDiagnostics maxBound (toNormalizedUri (Uri uri)) (Just version) diagnosticMap ,
notificationHandler STextDocumentDidChange $ \_not -> do
let NotificationMessage _ _ params = _not
DidChangeTextDocumentParams iD (List xs) = params
TextDocumentContentChangeEvent _ _ text = head xs
VersionedTextDocumentIdentifier (Uri uri) mVersion = iD
path <- liftIO $ writeTempFile (getPath $ T.unpack uri) text
norminetteResult <- liftIO . norminette $ path
liftIO $ removeFile path
publishDiagnostics maxBound (toNormalizedUri (Uri uri)) mVersion (partitionBySource norminetteResult) ,
notificationHandler STextDocumentDidSave $ \_not -> do
let NotificationMessage _ _ params = _not
DidSaveTextDocumentParams iD _ = params
TextDocumentIdentifier (Uri uri) = iD
norminetteResult <- liftIO . norminette $ getPath (T.unpack uri)
publishDiagnostics maxBound (toNormalizedUri (Uri uri)) Nothing (partitionBySource norminetteResult)
]
where getPath uri = case parseURI uri of
Just uri' -> uriPath uri'
_ -> ""
optionsNoSync :: Options
optionsNoSync = defaultOptions {textDocumentSync = Just syncOptions}
where syncOptions = TextDocumentSyncOptions {_openClose = Just True, _change = Nothing, _willSave = Nothing, _willSaveWaitUntil = Nothing, _save = Just $ InR (SaveOptions $ Just False)}
optionsSync :: Options
optionsSync = defaultOptions {textDocumentSync = Just syncOptions}
where syncOptions = TextDocumentSyncOptions {_openClose = Just True, _change = Just TdSyncFull, _willSave = Nothing, _willSaveWaitUntil = Nothing, _save = Just $ InR (SaveOptions $ Just False)}
-- norminette-lsp [--sync|--no-sync]
data Sync = Sync
| NoSync
parseArgs :: [String] -> Either T.Text Sync
parseArgs [x]
| x == "--sync" = Right Sync
| x == "--no-sync" = Right NoSync
| otherwise = Left "norminette-lsp [--sync|--no-sync]"
parseArgs _ = Left "norminette-lsp [--sync|--no-sync]"
main :: IO Int
main = do
args <- getArgs
let esync = parseArgs args
runServer $ ServerDefinition
{ onConfigurationChange = const $ pure $ Right ()
, doInitialize = \env _req -> do
case esync of
Left err -> return (Left (ResponseError ServerErrorStart err Nothing))
_ -> do
isNorminette <- findExecutable "norminette"
case isNorminette of
Nothing -> return (Left (ResponseError ServerErrorStart "No norminette executable found in $PATH" Nothing))
_ -> pure $ Right env
, staticHandlers = handlers
, interpretHandler = \env -> Iso (runLspT env) liftIO
, options = case esync of
Left _ -> defaultOptions
Right Sync -> optionsSync
Right NoSync -> optionsNoSync
}