change syntax dsl behavior so both choice operands get a following chain

packages/ribosome/lib/Ribosome/Internal/Syntax.hs

@@ -48,13 +48,18 @@ syntaxItemDetailCmd (SyntaxGroup grp) = \case
 
 syntaxItemCmd :: SyntaxItem -> [Text]
 syntaxItemCmd (SyntaxItem grp detail options params next contains contained) =
-  syntaxItemDetailCmd grp detail <> [
-    unwords (nubOrd (options <> containedOpt)),
-    joinEquals (withParam (coerce <$> contains) "contains" (withParam (coerce <$> next) "nextgroup" params))
-  ]
+  syntaxItemDetailCmd grp detail <> neSingle (unwords allOpt) <> neSingle allParams
   where
+    allOpt = nubOrd (options <> containedOpt)
+
+    allParams = joinEquals (withParam (coerce <$> contains) "contains" (withParam (coerce <$> next) "nextgroup" params))
+
+    neSingle t | Text.null t = []
+               | otherwise = [t]
+
     containedOpt =
       if contained then ["contained"] else []
+
     withParam val =
       if null val
       then const id
@@ -76,6 +81,10 @@ syntaxCmds :: Syntax -> [[Text]]
 syntaxCmds (Syntax items highlights hilinks) =
   (syntaxItemCmd <$> items) <> (highlightCmd <$> highlights) <> (hilinkCmd <$> hilinks)
 
+syntaxCmdlines :: Syntax -> [Text]
+syntaxCmdlines s =
+  Text.unwords <$> syntaxCmds s
+
 catCmd ::
   MonadRpc m =>
   [Text] ->

packages/ribosome/lib/Ribosome/Syntax/Build.hs

@@ -24,9 +24,6 @@ compileItem i = do
     & #contains %~ (<> contains)
 
 -- |Compile 'Alg'.
---
--- @contains@ and @next@ are reset on the left in Chain and Contain because they need to propagate to the end of a
--- subtree (right).
 spin ::
   Members [Writer [SyntaxItem], Writer [(Map Text Text, [SyntaxGroup])], Writer [HiLink], Reader Building] r =>
   Alg ->
@@ -36,13 +33,20 @@ spin = \case
     compiled <- compileItem i
     [compiled ^. #group] <$ tell [compiled]
   Chain l r -> do
+    -- @r@ should only ever match when requested by @l@.
+    -- Set @contained@ to prevent @r@ from matching at top level.
+    -- @contains@ propagates to both since there's no obvious interpretation of @(l >- r) #> i@.
     next <- local (#contained .~ True) (spin r)
-    local ((#next .~ next) . (#contains .~ [])) (spin l)
+    -- Set @next@ on @l@ to force @r@ afterwards.
+    local (#next .~ next) (spin l)
   Choice l r ->
+    -- Everything propagates to both alternatives.
     spin l <> spin r
   Contain l r -> do
+    -- Set @contained@ to prevent @r@ from matching at top level.
     next <- local ((#contained .~ True) . (#next .~ [])) (spin r)
-    local ((#contains .~ next) . (#next .~ [])) (spin l)
+    -- Set @contains@ to allow @r@ in @l@.
+    local (#contains .~ next) (spin l)
   Prefix pref s ->
     local (#prefix <>~ pref) (spin s)
   Hi vals s -> do

packages/test/test/Ribosome/Test/SyntaxTest.hs

@@ -1,28 +1,68 @@
 module Ribosome.Test.SyntaxTest where
 
+import qualified Data.Text as Text
 import Exon (exon)
-import Polysemy.Test (UnitTest)
+import Polysemy.Test (UnitTest, (===))
 
 import Ribosome.Api.Buffer (setCurrentBufferContent)
 import Ribosome.Api.Syntax (executeSyntax)
 import Ribosome.Data.Syntax.Syntax (Syntax)
+import Ribosome.Internal.Syntax (syntaxCmdlines)
 import Ribosome.Syntax.Build (build)
-import Ribosome.Syntax.Dsl (hi, link, match, prefix, region, (#>), (>-))
+import Ribosome.Syntax.Dsl (hi, link, match, prefix, region, (#>), (<#>), (>-))
 import Ribosome.Test.Screenshot (awaitScreenshot)
 import Ribosome.Test.SocketTmux (testSocketTmux)
 
-colonsHi :: Map Text Text
-colonsHi =
-  [("cterm", "reverse"), ("ctermfg", "1"), ("gui", "reverse"), ("guifg", "#dc322f")]
+hi1 :: Map Text Text
+hi1 =
+  [("cterm", "reverse"), ("ctermfg", "1")]
+
+hi2 :: Map Text Text
+hi2 =
+  [("cterm", "reverse"), ("ctermfg", "2")]
+
+hi3 :: Map Text Text
+hi3 =
+  [("cterm", "reverse"), ("ctermfg", "3")]
 
 syntax :: Syntax
 syntax =
-  build $ prefix "Test" $
-  region "Signature" [exon|\v^\w+ ::|] "$" #> hi colonsHi (match "Colons" "::") >- link "Type" (match "Type" ".*")
+  build $ prefix "Test" do
+    top1 <#> top2
+  where
+    top1 =
+      region "Signature" [exon|\v^\w+ ::|] "$" #> hi hi1 (match "Colons" "::") >- link "Type" (match "Type" ".*")
+
+    top2 = match "S" [exon|^S .\+$|] #> ((subA <#> subB) >- end)
+
+    subA = hi hi1 (match "A" "A a") #> hi hi2 (match "AInner" "a")
+
+    subB = hi hi1 (match "B" "B")
+
+    end = hi hi3 (match "E" [exon|E \d|])
+
+target :: Text
+target =
+  [exon|syntax match TestType /.*/ skipwhite contained
+syntax match TestColons /::/ skipwhite contained nextgroup=TestType
+syntax region TestSignature start=/\v^\w+ ::/ end=/$/ skipwhite contains=TestColons
+syntax match TestE /E \d/ skipwhite contained
+syntax match TestAInner /a/ skipwhite contained
+syntax match TestA /A a/ skipwhite contained contains=TestAInner nextgroup=TestE
+syntax match TestB /B/ skipwhite contained nextgroup=TestE
+syntax match TestS /^S .\+$/ skipwhite contains=TestA,TestB
+highlight default TestColons cterm=reverse ctermfg=1
+highlight default TestE cterm=reverse ctermfg=3
+highlight default TestAInner cterm=reverse ctermfg=2
+highlight default TestA cterm=reverse ctermfg=1
+highlight default TestB cterm=reverse ctermfg=1
+highlight default link TestType Type
+|]
 
 test_syntax :: UnitTest
 test_syntax =
   testSocketTmux do
-    setCurrentBufferContent ["function :: String -> Int", "function _ = 5"]
+    setCurrentBufferContent ["function :: String -> Int", "function _ = 5", "S A a E 1", "S B E 2"]
+    Text.lines target === syntaxCmdlines syntax
     executeSyntax syntax
     awaitScreenshot False "syntax" 0

packages/test/test/fixtures/screenshots/syntax

@@ -1,8 +1,8 @@
 function :: String -> Int
 function _ = 5
-~
-~
-~
+S A a E 1
+S B E 2
+~
 ~
 ~
 ~