2017-04-21 23:12:56 +03:00
|
|
|
|
{-# LANGUAGE DataKinds #-}
|
2017-04-07 19:21:45 +03:00
|
|
|
|
module Data.Syntax.Assignment.Spec where
|
2017-04-06 17:09:12 +03:00
|
|
|
|
|
2017-04-21 23:12:56 +03:00
|
|
|
|
import Data.ByteString.Char8 as B (words, length)
|
|
|
|
|
import Data.Record
|
2017-04-07 19:21:45 +03:00
|
|
|
|
import Data.Syntax.Assignment
|
2017-04-21 23:12:56 +03:00
|
|
|
|
import Info
|
2017-04-06 17:09:12 +03:00
|
|
|
|
import Prologue
|
2017-04-21 23:12:56 +03:00
|
|
|
|
import Source hiding (source, length)
|
2017-04-06 17:09:12 +03:00
|
|
|
|
import Test.Hspec
|
2017-04-18 18:06:24 +03:00
|
|
|
|
import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
|
2017-04-06 17:09:12 +03:00
|
|
|
|
|
|
|
|
|
spec :: Spec
|
2017-04-06 20:36:54 +03:00
|
|
|
|
spec = do
|
2017-04-07 21:47:31 +03:00
|
|
|
|
describe "Applicative" $ do
|
2017-04-07 16:45:23 +03:00
|
|
|
|
it "matches in sequence" $
|
2017-05-03 17:03:02 +03:00
|
|
|
|
runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result [] (Just (AssignmentState 10 (Info.SourcePos 1 11) [Regular] "" [], (Out "hello", Out "world")))
|
2017-04-07 16:14:03 +03:00
|
|
|
|
|
2017-04-07 21:47:23 +03:00
|
|
|
|
describe "Alternative" $ do
|
|
|
|
|
it "attempts multiple alternatives" $
|
2017-05-03 17:03:02 +03:00
|
|
|
|
runAssignment (green <|> red) (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (AssignmentState 5 (Info.SourcePos 1 6) [Regular] "" [], Out "hello"))
|
2017-04-07 21:47:23 +03:00
|
|
|
|
|
2017-04-07 16:45:23 +03:00
|
|
|
|
it "matches repetitions" $
|
2017-04-21 23:12:56 +03:00
|
|
|
|
let s = "colourless green ideas sleep furiously"
|
|
|
|
|
w = words s
|
|
|
|
|
(_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [Rose (rec Red i (i + B.length word)) []])) (0, []) w in
|
2017-05-03 17:03:02 +03:00
|
|
|
|
resultValue (runAssignment (many red) (makeState (Source s) nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) [Regular] "" [], Out <$> w)
|
2017-04-07 16:44:13 +03:00
|
|
|
|
|
2017-04-07 16:48:21 +03:00
|
|
|
|
it "matches one-or-more repetitions against one or more input nodes" $
|
2017-05-03 17:03:02 +03:00
|
|
|
|
resultValue (runAssignment (some red) (makeState "hello" [Rose (rec Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) [Regular] "" [], [Out "hello"])
|
2017-04-07 16:48:21 +03:00
|
|
|
|
|
2017-04-19 20:11:09 +03:00
|
|
|
|
describe "symbol" $ do
|
2017-04-07 21:50:57 +03:00
|
|
|
|
it "matches nodes with the same symbol" $
|
2017-05-03 16:39:24 +03:00
|
|
|
|
snd <$> runAssignment red (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (Out "hello"))
|
2017-04-07 21:50:57 +03:00
|
|
|
|
|
2017-04-07 21:59:13 +03:00
|
|
|
|
it "does not advance past the current node" $
|
2017-05-03 16:42:57 +03:00
|
|
|
|
let initialState = makeState "hi" [ Rose (rec Red 0 2) [] ] in
|
|
|
|
|
fst <$> runAssignment (symbol Red) initialState `shouldBe` Result [] (Just initialState)
|
2017-04-07 21:59:13 +03:00
|
|
|
|
|
2017-04-19 23:00:44 +03:00
|
|
|
|
describe "source" $ do
|
|
|
|
|
it "produces the node’s source" $
|
2017-05-03 16:40:52 +03:00
|
|
|
|
assign source "hi" (Rose (rec Red 0 2) []) `shouldBe` Result [] (Just "hi")
|
2017-04-07 21:57:00 +03:00
|
|
|
|
|
2017-04-07 21:57:44 +03:00
|
|
|
|
it "advances past the current node" $
|
2017-05-03 17:03:02 +03:00
|
|
|
|
fst <$> runAssignment source (makeState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) [Regular] "" []))
|
2017-04-07 21:57:44 +03:00
|
|
|
|
|
2017-04-07 21:39:13 +03:00
|
|
|
|
describe "children" $ do
|
|
|
|
|
it "advances past the current node" $
|
2017-05-03 17:03:02 +03:00
|
|
|
|
fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) [Regular] "" []))
|
2017-04-07 21:39:13 +03:00
|
|
|
|
|
2017-04-07 21:42:25 +03:00
|
|
|
|
it "matches if its subrule matches" $
|
2017-05-03 16:39:24 +03:00
|
|
|
|
() <$ runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result [] (Just ())
|
2017-04-07 21:42:25 +03:00
|
|
|
|
|
2017-04-07 21:43:53 +03:00
|
|
|
|
it "does not match if its subrule does not match" $
|
2017-05-03 16:39:24 +03:00
|
|
|
|
(runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result [ Error (Info.SourcePos 1 1) [Red] (Just Green) ] Nothing
|
2017-04-07 21:43:53 +03:00
|
|
|
|
|
2017-04-10 17:35:39 +03:00
|
|
|
|
it "matches nested children" $ do
|
|
|
|
|
runAssignment
|
2017-04-19 23:00:44 +03:00
|
|
|
|
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
|
2017-05-03 16:39:24 +03:00
|
|
|
|
(makeState "1" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ] ] ])
|
2017-04-10 17:35:39 +03:00
|
|
|
|
`shouldBe`
|
2017-05-03 17:03:02 +03:00
|
|
|
|
Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) [Regular] "" [], "1"))
|
2017-04-10 17:35:39 +03:00
|
|
|
|
|
2017-04-10 17:52:12 +03:00
|
|
|
|
it "continues after children" $ do
|
2017-05-01 17:05:36 +03:00
|
|
|
|
resultValue (runAssignment
|
2017-04-19 23:00:44 +03:00
|
|
|
|
(many (symbol Red *> children (symbol Green *> source)
|
|
|
|
|
<|> symbol Blue *> source))
|
2017-05-03 16:39:24 +03:00
|
|
|
|
(makeState "BC" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [] ]
|
|
|
|
|
, Rose (rec Blue 1 2) [] ]))
|
2017-04-10 17:52:12 +03:00
|
|
|
|
`shouldBe`
|
2017-05-03 17:03:02 +03:00
|
|
|
|
Just (AssignmentState 2 (Info.SourcePos 1 3) [Regular] "" [], ["B", "C"])
|
2017-04-10 17:52:12 +03:00
|
|
|
|
|
2017-04-10 18:24:30 +03:00
|
|
|
|
it "matches multiple nested children" $ do
|
|
|
|
|
runAssignment
|
2017-04-19 23:00:44 +03:00
|
|
|
|
(symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
|
2017-05-03 16:39:24 +03:00
|
|
|
|
(makeState "12" [ Rose (rec Red 0 2) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ]
|
|
|
|
|
, Rose (rec Green 1 2) [ Rose (rec Blue 1 2) [] ] ] ])
|
2017-04-10 18:24:30 +03:00
|
|
|
|
`shouldBe`
|
2017-05-03 17:03:02 +03:00
|
|
|
|
Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) [Regular] "" [], ["1", "2"]))
|
2017-04-10 18:24:30 +03:00
|
|
|
|
|
2017-05-03 17:07:53 +03:00
|
|
|
|
describe "runAssignment" $ do
|
|
|
|
|
it "drops anonymous nodes before matching" $
|
|
|
|
|
runAssignment red (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) [Regular] "" [], Out "red"))
|
|
|
|
|
|
2017-05-03 17:09:31 +03:00
|
|
|
|
it "does not drop anonymous nodes after matching" $
|
|
|
|
|
runAssignment red (makeState "red magenta" [Rose (rec Red 0 3) [], Rose (rec Magenta 4 11) []]) `shouldBe` Result [] (Just (AssignmentState 3 (Info.SourcePos 1 4) [Regular] " magenta" [Rose (rec Magenta 4 11) []], Out "red"))
|
|
|
|
|
|
2017-05-03 17:13:40 +03:00
|
|
|
|
describe "withTokens" $ do
|
|
|
|
|
it "preserves anonymous nodes before matching" $
|
|
|
|
|
runAssignment ((,) <$> withTokens magenta <*> red) (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) [Regular] "" [], (Out "magenta", Out "red")))
|
|
|
|
|
|
2017-04-21 23:12:56 +03:00
|
|
|
|
rec :: symbol -> Int -> Int -> Record '[symbol, Range, SourceSpan]
|
2017-04-24 17:27:45 +03:00
|
|
|
|
rec symbol start end = symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
|
|
|
|
|
|
2017-05-03 17:07:53 +03:00
|
|
|
|
data Grammar = Red | Green | Blue | Magenta
|
2017-04-26 18:29:13 +03:00
|
|
|
|
deriving (Enum, Eq, Show)
|
2017-04-07 19:36:14 +03:00
|
|
|
|
|
2017-04-18 18:06:24 +03:00
|
|
|
|
instance Symbol Grammar where
|
2017-05-03 17:07:53 +03:00
|
|
|
|
symbolType Magenta = Anonymous
|
2017-04-18 18:06:24 +03:00
|
|
|
|
symbolType _ = Regular
|
|
|
|
|
|
2017-04-07 19:36:14 +03:00
|
|
|
|
data Out = Out ByteString
|
|
|
|
|
deriving (Eq, Show)
|
|
|
|
|
|
2017-04-21 23:12:56 +03:00
|
|
|
|
red :: Assignment (Node Grammar) Out
|
2017-04-19 23:00:44 +03:00
|
|
|
|
red = Out <$ symbol Red <*> source
|
2017-04-07 19:36:14 +03:00
|
|
|
|
|
2017-04-21 23:12:56 +03:00
|
|
|
|
green :: Assignment (Node Grammar) Out
|
2017-04-19 23:00:44 +03:00
|
|
|
|
green = Out <$ symbol Green <*> source
|
2017-04-07 19:36:14 +03:00
|
|
|
|
|
2017-04-21 23:12:56 +03:00
|
|
|
|
blue :: Assignment (Node Grammar) Out
|
2017-04-19 23:00:44 +03:00
|
|
|
|
blue = Out <$ symbol Blue <*> source
|
2017-05-03 17:13:40 +03:00
|
|
|
|
|
|
|
|
|
magenta :: Assignment (Node Grammar) Out
|
|
|
|
|
magenta = Out <$ symbol Magenta <*> source
|