Parameterize the Parser type synonym by functor and annotation.

src/DiffOutput.hs

@@ -15,12 +15,13 @@ import qualified Renderer.Summary as S
 import Renderer
 import Renderer.Split
 import Source
+import Syntax
 import System.Directory
 import System.FilePath
 import qualified System.IO as IO
 
 -- | Returns a rendered diff given a parser, diff arguments and two source blobs.
-textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser fields -> DiffArguments -> Both SourceBlob -> IO Text
+textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Text
 textDiff parser arguments sources = case format arguments of
   Split -> diffFiles parser split sources
   Patch -> diffFiles parser P.patch sources
@@ -36,7 +37,7 @@ truncatedDiff arguments sources = case format arguments of
   Summary -> pure ""
 
 -- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs.
-printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser fields -> DiffArguments -> Both SourceBlob -> IO ()
+printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
 printDiff parser arguments sources = case format arguments of
   Split -> put (output arguments) =<< diffFiles parser split sources
     where

src/Diffing.hs

@@ -27,7 +27,7 @@ import TreeSitter
 import Text.Parser.TreeSitter.Language
 
 -- | Return a parser based on the file extension (including the ".").
-parserForType :: T.Text -> Parser '[Range, Category, Cost]
+parserForType :: T.Text -> Parser (Syntax Text) (Record '[Range, Category])
 parserForType mediaType = case languageForType mediaType of
   Just C -> treeSitterParser C ts_language_c
   Just JavaScript -> treeSitterParser JavaScript ts_language_javascript
@@ -35,7 +35,7 @@ parserForType mediaType = case languageForType mediaType of
   _ -> lineByLineParser
 
 -- | A fallback parser that treats a file simply as rows of strings.
-lineByLineParser :: Parser '[Range, Category, Cost]
+lineByLineParser :: Parser (Syntax Text) (Record '[Range, Category])
 lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([], 0) lines of
   (leaves, _) -> cofree <$> leaves
   where
@@ -49,7 +49,7 @@ lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([],
     toText = T.pack . Source.toString
 
 -- | Return the parser that should be used for a given path.
-parserForFilepath :: FilePath -> Parser '[Range, Category, Cost]
+parserForFilepath :: FilePath -> Parser (Syntax Text) (Record '[Range, Category])
 parserForFilepath = parserForType . T.pack . takeExtension
 
 -- | Replace every string leaf with leaves of the words in the string.
@@ -84,7 +84,7 @@ decorateTerm decorator = cata $ \ c -> cofree ((decorator (extract <$> c) .: hea
 -- | result.
 -- | Returns the rendered result strictly, so it's always fully evaluated
 -- | with respect to other IO actions.
-diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, Eq (Record fields)) => Parser fields -> Renderer (Record fields) -> Both SourceBlob -> IO T.Text
+diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, Eq (Record fields)) => Parser (Syntax Text) (Record fields) -> Renderer (Record fields) -> Both SourceBlob -> IO T.Text
 diffFiles parser renderer sourceBlobs = do
   let sources = source <$> sourceBlobs
   terms <- sequence $ parser <$> sources

src/Parser.hs

@@ -14,7 +14,7 @@ import Source
 -- | A function that takes a source file and returns an annotated AST.
 -- | The return is in the IO monad because some of the parsers are written in C
 -- | and aren't pure.
-type Parser fields = Source Char -> IO (Term Text (Record fields))
+type Parser f a = Source Char -> IO (Cofree f a)
 
 -- | Categories that are treated as fixed nodes.
 fixedCategories :: Set.Set Category

src/TreeSitter.hs

@@ -10,13 +10,14 @@ import Language
 import Parser
 import Range
 import Source
+import Syntax
 import Foreign
 import Foreign.C.String
 import Text.Parser.TreeSitter hiding (Language(..))
 import qualified Text.Parser.TreeSitter as TS
 
 -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
-treeSitterParser :: Language -> Ptr TS.Language -> Parser '[Range, Category, Cost]
+treeSitterParser :: Language -> Ptr TS.Language -> Parser (Syntax Text) (Record '[Range, Category, Cost])
 treeSitterParser language grammar contents = do
   document <- ts_document_make
   ts_document_set_language document grammar
@@ -50,7 +51,7 @@ defaultCategoryForNodeName name = case name of
   _ -> Other name
 
 -- | Return a parser for a tree sitter language & document.
-documentToTerm :: Language -> Ptr Document -> Parser '[Range, Category, Cost]
+documentToTerm :: Language -> Ptr Document -> Parser (Syntax Text) (Record '[Range, Category, Cost])
 documentToTerm language document contents = alloca $ \ root -> do
   ts_document_root_node_p document root
   toTerm root