Improve parsing of FileCheck-style tags.

This used to operate via some fast-and-loose (ab)use of the Trifecta
API. A simpler way to do things is to use streaming-bytestring to load
a file line by line and parse directives until we encounter program text.

semantic-python/semantic-python.cabal

@@ -67,6 +67,7 @@ test-suite test
                , pathtype ^>= 0.8.1
                , pretty-show ^>= 1.9.5
                , process ^>= 1.6.5
+               , resourcet ^>= 1.2.2
                , streaming ^>= 0.2.2
                , streaming-process ^>= 0.1
                , streaming-bytestring ^>= 0.1.6

semantic-python/test/Directive.hs

@@ -1,5 +1,5 @@
 module Directive ( Directive (..)
-                 , parseDirectives
+                 , parseDirective
                  , describe
                  , toProcess
                  ) where
@@ -57,23 +57,20 @@ fails = Fails <$ Trifecta.string "# CHECK-FAILS"
 
 jq :: Trifecta.Parser Directive
 jq = do
-  Trifecta.string "# CHECK-JQ: "
+  void $ Trifecta.string "# CHECK-JQ: "
   JQ . ByteString.pack <$> many (Trifecta.noneOf "\n")
 
 tree :: Trifecta.Parser Directive
 tree = do
   void $ Trifecta.string "# CHECK-TREE: "
-  Tree <$> (Core.Parser.record <|> Core.Parser.comp <|> Trifecta.parens Core.Parser.core)
+  Tree <$> Core.Parser.core
 
 directive :: Trifecta.Parser Directive
 directive = Trifecta.choice [ fails, jq, tree ]
 
-toplevel :: Trifecta.Parser (NonEmpty Directive)
-toplevel = directive `Trifecta.sepEndByNonEmpty` Trifecta.char '\n'
-
-parseDirectives :: ByteString -> Either String (NonEmpty Directive)
-parseDirectives = Trifecta.foldResult (Left . show) Right
-                . Trifecta.parseByteString toplevel mempty
+parseDirective :: ByteString -> Either String Directive
+parseDirective = Trifecta.foldResult (Left . show) Right
+                . Trifecta.parseByteString (directive <* Trifecta.eof) mempty
 
 toProcess :: Directive -> CreateProcess
 toProcess (JQ d) = proc "jq" ["-e", ByteString.unpack d]

semantic-python/test/Test.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GeneralizedNewtypeDeriving, OverloadedStrings, TypeApplications, TypeOperators #-}
+{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GeneralizedNewtypeDeriving, OverloadedStrings, TypeApplications, TypeOperators, ScopedTypeVariables #-}
 
 module Main (main) where
 
@@ -9,6 +9,7 @@ import           Control.Effect.Reader
 import           Control.Monad hiding (fail)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.ByteString.Char8 as ByteString
@@ -29,6 +30,7 @@ import           GHC.Stack
 import qualified Language.Python.Core as Py
 import           Prelude hiding (fail)
 import           Streaming
+import qualified Streaming.Prelude as Stream
 import qualified Streaming.Process
 import           System.Directory
 import           System.Exit
@@ -76,13 +78,23 @@ assertJQExpressionSucceeds directive tree core = do
 fixtureTestTreeForFile :: HasCallStack => Path.RelFile -> Tasty.TestTree
 fixtureTestTreeForFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFrozenCallStack $ do
   let fullPath = Path.relDir "semantic-python/test/fixtures" </> fp
+      perish s = liftIO (HUnit.assertFailure ("Directive parsing error: " <> s))
 
-  fileContents <- ByteString.readFile (Path.toString fullPath)
-  directives <- case Directive.parseDirectives fileContents of
-    Right dir -> pure dir
-    Left err  -> HUnit.assertFailure ("Directive parsing error: " <> err)
+  -- Slurp the input file, taking lines from the beginning until we
+  -- encounter a line that doesn't have a '#'. For each line, parse
+  -- a directive out of it, failing if the directive can't be parsed.
+  directives <-
+    runResourceT
+    . Stream.toList_
+    . Stream.mapM (either perish pure . Directive.parseDirective)
+    . Stream.takeWhile ((== '#') . ByteString.head)
+    . Stream.mapped ByteStream.toStrict
+    . ByteStream.denull
+    . ByteStream.lines
+    . ByteStream.readFile @(ResourceT IO)
+    $ Path.toString fullPath
 
-  result <- TS.parseByteString TSP.tree_sitter_python fileContents
+  result <- ByteString.readFile (Path.toString fullPath) >>= TS.parseByteString TSP.tree_sitter_python
   let coreResult = Control.Effect.run
                    . runFail
                    . runReader (fromString @Py.SourcePath . Path.toString $ fp)