lsp-test/Main.hs

   1 module Main where
   2
   3 import           Control.Monad
   4 import           Data.Aeson
   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
  16
  17 main = do
  18   fileName <- head <$> getArgs
  19   blocks <- parseScript <$> readFile fileName
  20   print blocks
  21   rootDir <- getCurrentDirectory
  22   runBlocks rootDir blocks
  23
  24 runBlocks :: FilePath -> [Block] -> IO ()
  25 runBlocks rootDir blocks = runMachine rootDir (map convertBlock blocks) >>= putStrLn
  26   where
  27     convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
  28     convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
  29
  30     mkWait :: Wait -> FromServerMessage -> Bool
  31     mkWait WaitAny _ = True
  32     mkWait (WaitPred preds) x = all (`mkPred` x) preds
  33
  34     mkPred :: Predicate -> (FromServerMessage -> Bool)
  35     mkPred (Predicate accessor comparison) msg =
  36       let (Object obj) = toJSONMsg msg in comp (access obj accessor) comparison
  37
  38     comp (Just (String str)) (EqualsString expected) = str == T.pack expected
  39     comp (Just (Number num)) (EqualsNumber expected) = num == expected
  40     comp _ _ = False
  41
  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
  47         _ -> Nothing
  48
  49     mkAction :: Action -> Session ()
  50
  51     mkAction (OpenDoc fp fileType) = void $ openDoc fp fileType
  52
  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)
  56
  57     strToMethod str = case fromJSON (String $ T.pack str) of
  58       Success x -> x
  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)