From d1ed01544625b5da19ace1544ec14742336b2307 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@github.com>
Date: Thu, 14 Jul 2016 16:35:20 -0400
Subject: [PATCH] Parser takes a list of field types.

---
 src/DiffOutput.hs | 8 ++++++--
 src/Diffing.hs    | 9 +++++----
 src/Parser.hs     | 2 +-
 src/TreeSitter.hs | 5 +++--
 4 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/DiffOutput.hs b/src/DiffOutput.hs
index 026786e2d..5aa5b4268 100644
--- a/src/DiffOutput.hs
+++ b/src/DiffOutput.hs
@@ -1,10 +1,14 @@
 module DiffOutput where
 
+import Category
 import Prologue
 import qualified Data.Text.IO as TextIO
 import Data.Functor.Both
+import Data.Record
 import Diffing
+import Info
 import Parser
+import Range
 import qualified Renderer.JSON as J
 import qualified Renderer.Patch as P
 import qualified Renderer.Summary as S
@@ -16,7 +20,7 @@ import System.FilePath
 import qualified System.IO as IO
 
 -- | Returns a rendered diff given a parser, diff arguments and two source blobs.
-textDiff :: Parser -> DiffArguments -> Both SourceBlob -> IO Text
+textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size) => Parser 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
@@ -32,7 +36,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 :: Parser -> DiffArguments -> Both SourceBlob -> IO ()
+printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size) => Parser fields -> DiffArguments -> Both SourceBlob -> IO ()
 printDiff parser arguments sources = case format arguments of
   Split -> put (output arguments) =<< diffFiles parser split sources
     where
diff --git a/src/Diffing.hs b/src/Diffing.hs
index 14e411722..4042a843e 100644
--- a/src/Diffing.hs
+++ b/src/Diffing.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 module Diffing where
 
 import Prologue hiding (fst, snd)
@@ -26,7 +27,7 @@ import TreeSitter
 import Text.Parser.TreeSitter.Language
 
 -- | Return a parser based on the file extension (including the ".").
-parserForType :: T.Text -> Parser
+parserForType :: T.Text -> Parser '[Range, Category, Size, Cost]
 parserForType mediaType = case languageForType mediaType of
   Just C -> treeSitterParser C ts_language_c
   Just JavaScript -> treeSitterParser JavaScript ts_language_javascript
@@ -34,7 +35,7 @@ parserForType mediaType = case languageForType mediaType of
   _ -> lineByLineParser
 
 -- | A fallback parser that treats a file simply as rows of strings.
-lineByLineParser :: Parser
+lineByLineParser :: Parser '[Range, Category, Size, Cost]
 lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([], 0) lines of
   (leaves, _) -> cofree <$> leaves
   where
@@ -48,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
+parserForFilepath :: FilePath -> Parser '[Range, Category, Size, Cost]
 parserForFilepath = parserForType . T.pack . takeExtension
 
 -- | Replace every string leaf with leaves of the words in the string.
@@ -81,7 +82,7 @@ readAndTranscodeFile path = do
 -- | result.
 -- | Returns the rendered result strictly, so it's always fully evaluated
 -- | with respect to other IO actions.
-diffFiles :: Parser -> Renderer -> Both SourceBlob -> IO T.Text
+diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size, Eq (Record fields)) => Parser fields -> Renderer -> Both SourceBlob -> IO T.Text
 diffFiles parser renderer sourceBlobs = do
   let sources = source <$> sourceBlobs
   terms <- sequence $ parser <$> sources
diff --git a/src/Parser.hs b/src/Parser.hs
index 2fc68c851..f131f101f 100644
--- a/src/Parser.hs
+++ b/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 = Source Char -> IO (Term Text Info)
+type Parser fields = Source Char -> IO (Term Text (Record fields))
 
 -- | Categories that are treated as fixed nodes.
 fixedCategories :: Set.Set Category
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index 6b8b11b87..ff8b6b6ca 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 module TreeSitter where
 
 import Prologue hiding (Constructor)
@@ -15,7 +16,7 @@ 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
+treeSitterParser :: Language -> Ptr TS.Language -> Parser '[Range, Category, Size, Cost]
 treeSitterParser language grammar contents = do
   document <- ts_document_make
   ts_document_set_language document grammar
@@ -49,7 +50,7 @@ defaultCategoryForNodeName name = case name of
   _ -> Other name
 
 -- | Return a parser for a tree sitter language & document.
-documentToTerm :: Language -> Ptr Document -> Parser
+documentToTerm :: Language -> Ptr Document -> Parser '[Range, Category, Size, Cost]
 documentToTerm language document contents = alloca $ \ root -> do
   ts_document_root_node_p document root
   toTerm root