1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 23:11:50 +03:00
semantic/test/Data/Syntax/Assignment/Spec.hs
Rob Rix 5c0d27c1a2 Test that overlapping choices match the right branch.
This currently fails due to the left-biased nature of how we merge committed choices.
2017-07-26 11:11:15 -04:00

232 lines
8.7 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# LANGUAGE DataKinds #-}
module Data.Syntax.Assignment.Spec where
import Data.ByteString.Char8 as B (words, length)
import Data.Source
import Data.Syntax.Assignment
import Info
import Prologue hiding (State)
import Test.Hspec
import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
spec :: Spec
spec = do
describe "Applicative" $
it "matches in sequence" $
fst <$> runAssignment headF "helloworld" ((,) <$> red <*> red) (makeState [node Red 0 5 [], node Red 5 10 []])
`shouldBe`
Right (Out "hello", Out "world")
describe "Alternative" $ do
it "attempts multiple alternatives" $
fst <$> runAssignment headF "hello" (green <|> red) (makeState [node Red 0 5 []])
`shouldBe`
Right (Out "hello")
it "matches repetitions" $
let s = "colourless green ideas sleep furiously"
w = words s
(_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
fst <$> runAssignment headF (fromBytes s) (many red) (makeState nodes)
`shouldBe`
Right (Out <$> w)
it "matches one-or-more repetitions against one or more input nodes" $
fst <$> runAssignment headF "hello" (some red) (makeState [node Red 0 5 []])
`shouldBe`
Right [Out "hello"]
it "distributes through overlapping committed choices, matching the left alternative" $
fst <$> runAssignment headF "(red (green))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 13 [node Green 5 12 []]])
`shouldBe`
Right (Out "(green)")
it "distributes through overlapping committed choices, matching the right alternative" $
fst <$> runAssignment headF "(red (blue))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 12 [node Blue 5 11 []]])
`shouldBe`
Right (Out "(blue)")
describe "symbol" $ do
it "matches nodes with the same symbol" $
fst <$> runAssignment headF "hello" red (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello")
it "does not advance past the current node" $
runAssignment headF "hi" (symbol Red) (makeState [ node Red 0 2 [] ]) `shouldBe` Left (Error (Info.Pos 1 1) [] (Just Red))
describe "without catchError" $ do
it "assignment returns unexpected symbol error" $
runAssignment headF "A"
red
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) [Red] (Just Green))
it "assignment returns unexpected end of input" $
runAssignment headF "A"
(symbol Green *> children (some red))
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) [Red] Nothing)
describe "catchError" $ do
it "handler that always matches" $
fst <$> runAssignment headF "A"
(red `catchError` (\ _ -> OutError <$ location <*> source))
(makeState [node Green 0 1 []])
`shouldBe`
Right (OutError "A")
it "handler that matches" $
fst <$> runAssignment headF "A"
(red `catchError` const green)
(makeState [node Green 0 1 []])
`shouldBe`
Right (Out "A")
it "handler that doesn't match produces error" $
runAssignment headF "A"
(red `catchError` const blue)
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) [Blue] (Just Green))
describe "in many" $ do
it "handler that always matches" $
fst <$> runAssignment headF "PG"
(symbol Palette *> children (
many (red `catchError` (\ _ -> OutError <$ location <*> source))
))
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right [OutError "G"]
it "handler that matches" $
fst <$> runAssignment headF "PG"
(symbol Palette *> children ( many (red `catchError` const green) ))
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right [Out "G"]
it "handler that doesn't match produces error" $
runAssignment headF "PG"
(symbol Palette *> children ( many (red `catchError` const blue) ))
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Left (Error (Info.Pos 1 2) [Blue] (Just Green))
it "handler that always matches with apply consumes and then errors" $
runAssignment headF "PG"
(symbol Palette *> children (
(,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green
))
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Left (Error (Info.Pos 1 3) [Green] Nothing)
it "handler that doesn't match with apply" $
fst <$> runAssignment headF "PG"
(symbol Palette *> children (
(,) <$> many (red `catchError` const blue) <*> green
))
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right ([], Out "G")
describe "many" $ do
it "takes ones and only one zero width repetition" $
fst <$> runAssignment headF "PGG"
(symbol Palette *> children ( many (green <|> pure (Out "always")) ))
(makeState [node Palette 0 1 [node Green 1 2 [], node Green 2 3 []]])
`shouldBe`
Right [Out "G", Out "G", Out "always"]
describe "source" $ do
it "produces the nodes source" $
assignBy headF "hi" source (node Red 0 2 []) `shouldBe` Right "hi"
it "advances past the current node" $
snd <$> runAssignment headF "hi" source (makeState [ node Red 0 2 [] ])
`shouldBe`
Right (State 2 (Info.Pos 1 3) Nothing 1 [])
describe "children" $ do
it "advances past the current node" $
snd <$> runAssignment headF "a" (children (pure (Out ""))) (makeState [node Red 0 1 []])
`shouldBe`
Right (State 1 (Info.Pos 1 2) Nothing 1 [])
it "matches if its subrule matches" $
() <$ runAssignment headF "a" (children red) (makeState [node Blue 0 1 [node Red 0 1 []]])
`shouldBe`
Right ()
it "does not match if its subrule does not match" $
runAssignment headF "a" (children red) (makeState [node Blue 0 1 [node Green 0 1 []]])
`shouldBe`
Left (Error (Info.Pos 1 1) [Red] (Just Green))
it "matches nested children" $
fst <$> runAssignment headF "1"
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
(makeState [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
`shouldBe`
Right "1"
it "continues after children" $
fst <$> runAssignment headF "BC"
(many (symbol Red *> children (symbol Green *> source)
<|> symbol Blue *> source))
(makeState [ node Red 0 1 [ node Green 0 1 [] ]
, node Blue 1 2 [] ])
`shouldBe`
Right ["B", "C"]
it "matches multiple nested children" $
fst <$> runAssignment headF "12"
(symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
(makeState [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
, node Green 1 2 [ node Blue 1 2 [] ] ] ])
`shouldBe`
Right ["1", "2"]
describe "runAssignment" $ do
it "drops anonymous nodes before matching symbols" $
fst <$> runAssignment headF "magenta red" red (makeState [node Magenta 0 7 [], node Red 8 11 []])
`shouldBe`
Right (Out "red")
it "does not drop anonymous nodes after matching" $
stateNodes . snd <$> runAssignment headF "red magenta" red (makeState [node Red 0 3 [], node Magenta 4 11 []])
`shouldBe`
Right [node Magenta 4 11 []]
it "does not drop anonymous nodes when requested" $
fst <$> runAssignment headF "magenta red" ((,) <$> magenta <*> red) (makeState [node Magenta 0 7 [], node Red 8 11 []])
`shouldBe`
Right (Out "magenta", Out "red")
node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol
node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children
data Grammar = Palette | Red | Green | Blue | Magenta
deriving (Enum, Eq, Show)
instance Symbol Grammar where
symbolType Magenta = Anonymous
symbolType _ = Regular
data Out = Out ByteString | OutError ByteString
deriving (Eq, Show)
red :: Assignment (AST Grammar) Grammar Out
red = Out <$ symbol Red <*> source
green :: Assignment (AST Grammar) Grammar Out
green = Out <$ symbol Green <*> source
blue :: Assignment (AST Grammar) Grammar Out
blue = Out <$ symbol Blue <*> source
magenta :: Assignment (AST Grammar) Grammar Out
magenta = Out <$ symbol Magenta <*> source