src/Language/Haskell/LSP/Test/Script.hs

   1 module Main where
   2
   3 import Control.Applicative ( (<|>), some )
   4 import Data.Char
   5 import Text.ParserCombinators.ReadP
   6 import System.Environment
   7
   8 {-
   9  - "asdf"
  10  -    wait for
  11  -      asdsdf == "asdf"
  12  -      adsf   == "adsf"
  13  -    send
  14  -      foo
  15  -      bar
  16  -
  17  -  str   ::= " char "
  18  -  wait  ::= wait for (pred+ | any)
  19  -  pred  ::= x == y
  20  -  send  ::= send msg+
  21  -  msg   ::= str
  22  -  block ::= str wait send?
  23  -}
  24
  25 data Block = Block String Wait (Maybe Send)
  26   deriving Show
  27 data Wait = WaitPred [Predicate]
  28           | WaitAny
  29   deriving Show
  30 data Predicate = Predicate String String
  31   deriving Show
  32 data Send = Send [Message]
  33   deriving Show
  34 type Message = String
  35
  36 skip = skipMany $ satisfy isSpace <|> char '\n' <|> char '\r'
  37
  38 strLit :: ReadP String
  39 strLit = between (char '"') (char '"') (many (satisfy (/= '"')))
  40
  41 block :: ReadP Block
  42 block = do
  43   skip
  44   name <- strLit
  45   skip
  46   w <- wait
  47   skip
  48   s <- option Nothing (Just <$> send)
  49   return $ Block name w s
  50
  51 wait :: ReadP Wait
  52 wait = do
  53   string "wait for"
  54   skip
  55   f <|> g
  56   where f = string "any" >> return WaitAny
  57         g = WaitPred <$> some predicate
  58
  59 predicate :: ReadP Predicate
  60 predicate = do
  61   skip
  62   x <- strLit
  63   skip
  64   string "=="
  65   skip
  66   y <- strLit
  67   return $ Predicate x y
  68
  69 send :: ReadP Send
  70 send = do
  71   -- skip
  72   string "send"
  73   Send <$> some (skip >> strLit)
  74
  75 parseScript :: String -> [Block]
  76 parseScript = fst . last . readP_to_S (some block)
  77
  78 main = do
  79   fileName <- head <$> getArgs
  80   print . parseScript =<< readFile fileName