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
12 import Language.Haskell.LSP.Test.Machine
13 import Language.Haskell.LSP.Test.Parsing ( toJSONMsg )
14 import Language.Haskell.LSP.Messages
15 import qualified Language.Haskell.LSP.Types as LSP
18 fileName <- head <$> getArgs
19 blocks <- parseScript <$> readFile fileName
21 rootDir <- getCurrentDirectory
22 runBlocks rootDir blocks
24 runBlocks :: FilePath -> [Block] -> IO ()
25 runBlocks rootDir blocks = runMachine rootDir (map convertBlock blocks) >>= putStrLn
27 convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
28 convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
30 mkWait :: Wait -> FromServerMessage -> Bool
31 mkWait WaitAny _ = True
32 mkWait (WaitPred preds) x = all (`mkPred` x) preds
34 mkPred :: Predicate -> (FromServerMessage -> Bool)
35 mkPred (Predicate accessor comparison) msg =
36 let (Object obj) = toJSONMsg msg in comp (access obj accessor) comparison
38 comp (Just (String str)) (EqualsString expected) = str == T.pack expected
39 comp (Just (Number num)) (EqualsNumber expected) = num == expected
42 access :: Object -> Accessor -> Maybe Value
43 access obj (AccessorTerm prop) = HM.lookup (T.pack prop) obj
44 access obj (Accessor prop next) =
45 case HM.lookup (T.pack prop) obj of
46 Just (Object nextObj) -> access nextObj next
49 mkAction :: Action -> Session ()
51 mkAction (OpenDoc fp fileType) = void $ openDoc fp fileType
53 mkAction (Request identifier methodStr ps) = void $ sendRequest' (strToMethod methodStr) (paramToValue ps)
54 mkAction (Reply methodStr ps) = undefined -- TODO
55 mkAction (Notify methodStr ps) = void $ sendNotification (strToMethod methodStr) (paramToValue ps)
57 strToMethod str = case fromJSON (String $ T.pack str) of
59 Error _ -> error $ str ++ " is not a valid method"
60 paramToValue (ParamString str) = String str
61 paramToValue (ParamUri uri) = toJSON $ LSP.filePathToUri (rootDir </> uri)
62 paramToValue (ParamObject obj) = Object (HM.map paramToValue obj)