mirror of
https://github.com/github/semantic.git
synced 2024-12-23 14:54:16 +03:00
94 lines
3.2 KiB
Haskell
94 lines
3.2 KiB
Haskell
module Data.Syntax.Assignment.Spec where
|
||
|
||
import Data.ByteString.Char8 (words)
|
||
import Data.Syntax.Assignment
|
||
import Prologue
|
||
import Test.Hspec
|
||
import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
|
||
|
||
spec :: Spec
|
||
spec = do
|
||
describe "Applicative" $ do
|
||
it "matches in sequence" $
|
||
runAssignment ((,) <$> red <*> red) [ast Red "hello" [], ast Red "world" []] `shouldBe` Result ([], (Out "hello", Out "world"))
|
||
|
||
describe "Alternative" $ do
|
||
it "attempts multiple alternatives" $
|
||
runAssignment (green <|> red) [ast Red "hello" []] `shouldBe` Result ([], Out "hello")
|
||
|
||
it "matches repetitions" $
|
||
let w = words "colourless green ideas sleep furiously" in
|
||
runAssignment (many red) (flip (ast Red) [] <$> w) `shouldBe` Result ([], Out <$> w)
|
||
|
||
it "matches one-or-more repetitions against one or more input nodes" $
|
||
runAssignment (some red) [ast Red "hello" []] `shouldBe` Result ([], [Out "hello"])
|
||
|
||
describe "rule" $ do
|
||
it "matches nodes with the same symbol" $
|
||
runAssignment red [ast Red "hello" []] `shouldBe` Result ([], Out "hello")
|
||
|
||
it "does not advance past the current node" $
|
||
fst <$> runAssignment (rule Red) [ Rose (Node Red "hi") [] ] `shouldBe` Result [ Rose (Node Red "hi") [] ]
|
||
|
||
describe "content" $ do
|
||
it "produces the node’s content" $
|
||
snd <$> runAssignment content [ Rose (Node Red "hi") [] ] `shouldBe` Result "hi"
|
||
|
||
it "advances past the current node" $
|
||
fst <$> runAssignment content [ Rose (Node Red "hi") [] ] `shouldBe` Result []
|
||
|
||
describe "children" $ do
|
||
it "advances past the current node" $
|
||
fst <$> runAssignment (children (pure (Out ""))) [ast Red "a" []] `shouldBe` Result []
|
||
|
||
it "matches if its subrule matches" $
|
||
() <$ runAssignment (children red) [ast Blue "b" [ast Red "a" []]] `shouldBe` Result ()
|
||
|
||
it "does not match if its subrule does not match" $
|
||
runAssignment (children red) [ast Blue "b" [ast Green "a" []]] `shouldBe` Error []
|
||
|
||
it "matches nested children" $ do
|
||
runAssignment
|
||
(rule Red *> children (rule Green *> children (rule Blue *> content)))
|
||
[ ast Red "" [ ast Green "" [ ast Blue "1" [] ] ] ]
|
||
`shouldBe`
|
||
Result ([], "1")
|
||
|
||
it "continues after children" $ do
|
||
runAssignment
|
||
(many (rule Red *> children (rule Green *> content)
|
||
<|> rule Blue *> content))
|
||
[ ast Red "" [ ast Green "B" [] ]
|
||
, ast Blue "C" [] ]
|
||
`shouldBe`
|
||
Result ([], ["B", "C"])
|
||
|
||
it "matches multiple nested children" $ do
|
||
runAssignment
|
||
(rule Red *> children (many (rule Green *> children (rule Blue *> content))))
|
||
[ ast Red "" [ ast Green "" [ ast Blue "1" [] ]
|
||
, ast Green "" [ ast Blue "2" [] ] ] ]
|
||
`shouldBe`
|
||
Result ([], ["1", "2"])
|
||
|
||
ast :: grammar -> ByteString -> [AST grammar] -> AST grammar
|
||
ast g s c = Rose (Node g s) c
|
||
|
||
data Grammar = Red | Green | Blue
|
||
deriving (Eq, Show)
|
||
|
||
instance Symbol Grammar where
|
||
symbolType _ = Regular
|
||
|
||
data Out = Out ByteString
|
||
deriving (Eq, Show)
|
||
|
||
red :: Assignment Grammar Out
|
||
red = Out <$ rule Red <*> content
|
||
|
||
green :: Assignment Grammar Out
|
||
green = Out <$ rule Green <*> content
|
||
|
||
blue :: Assignment Grammar Out
|
||
blue = Out <$ rule Blue <*> content
|