5 import qualified Data.Text as T
6 import qualified Data.HashMap.Lazy as HM
7 import Language.Haskell.LSP.Test
8 import Language.Haskell.LSP.Test.Script
9 import System.Environment
10 import System.FilePath
11 import System.Directory
13 import Language.Haskell.LSP.Test.Machine
14 import Language.Haskell.LSP.Test.Parsing
16 import Language.Haskell.LSP.Test.Replay
17 import Language.Haskell.LSP.Messages
18 import qualified Language.Haskell.LSP.Types as LSP
22 curDir <- getCurrentDirectory
24 ["replay", cmd] -> replaySession cmd curDir
26 blocks <- parseScript <$> readFile file
27 success <- runBlocks cmd curDir blocks
29 then putStrLn "Success ✅"
30 else putStrLn "Failed ❌" >> exitFailure
31 _ -> putStrLn "usage: lsp-test (replay <cmd>)|(<file> <cmd>)"
33 runBlocks :: String -> FilePath -> [Block] -> IO Bool
34 runBlocks cmd rootDir blocks = runMachine cmd rootDir (map convertBlock blocks)
36 convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
37 convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
39 mkWait :: Wait -> FromServerMessage -> Bool
40 mkWait WaitAny _ = True
41 mkWait (WaitPred preds) x = all (`mkPred` x) preds
43 mkPred :: Predicate -> (FromServerMessage -> Bool)
44 mkPred (Predicate accessor comparison) msg =
45 let (Object obj) = toJSONMsg msg in comp (access obj accessor) comparison
47 comp (Just (String str)) (EqualsString expected) = str == T.pack expected
48 comp (Just (Number num)) (EqualsNumber expected) = num == expected
51 access :: Object -> Accessor -> Maybe Value
52 access obj (AccessorTerm prop) = HM.lookup (T.pack prop) obj
53 access obj (Accessor prop next) =
54 case HM.lookup (T.pack prop) obj of
55 Just (Object nextObj) -> access nextObj next
58 mkAction :: Action -> Session ()
60 mkAction (OpenDoc fp fileType) = void $ openDoc fp fileType
62 mkAction (Request identifier methodStr ps) = void $ sendRequest' (strToMethod methodStr) (paramToValue ps)
63 mkAction (Reply methodStr ps) = undefined -- TODO
64 mkAction (Notify methodStr ps) = void $ sendNotification (strToMethod methodStr) (paramToValue ps)
66 strToMethod str = case fromJSON (String $ T.pack str) of
68 Error _ -> error $ str ++ " is not a valid method"
69 paramToValue (ParamString str) = String str
70 paramToValue (ParamUri uri) = toJSON $ LSP.filePathToUri (rootDir </> uri)
71 paramToValue (ParamObject obj) = Object (HM.map paramToValue obj)