From 4190abe065dcf78318bfaa6263f1ef4a9fc98774 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@github.com>
Date: Tue, 16 Aug 2016 09:50:50 -0400
Subject: [PATCH] Generalize termConstructor to return its argument in a Monad.

---
 src/Parser.hs     | 4 ++--
 src/TreeSitter.hs | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 3f731ee1b..90279e48b 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -23,8 +23,8 @@ isOperator = flip Set.member (Set.fromList [ Operator, BinaryOperator ])
 
 -- | Given a function that maps production names to sets of categories, produce
 -- | a Constructor.
-termConstructor :: forall fields. (Show (Record fields), HasField fields Category, HasField fields Range) => Source Char -> SourceSpan -> Record fields -> [Term Text (Record fields)] -> Term Text (Record fields)
-termConstructor source sourceSpan info = cofree . construct
+termConstructor :: forall fields m. (Show (Record fields), HasField fields Category, HasField fields Range, Monad m) => Source Char -> SourceSpan -> Record fields -> [Term Text (Record fields)] -> m (Term Text (Record fields))
+termConstructor source sourceSpan info terms = pure $! cofree (construct terms)
   where
     withDefaultInfo syntax = (info :< syntax)
     errorWith = (seq sourceSpan) . withDefaultInfo . S.Error sourceSpan
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index 4292e0b17..fa85ec669 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -118,6 +118,6 @@ documentToTerm language document blob = alloca $ \ root -> do
           -- Note: The strict application here is semantically important. Without it, we may not evaluate the range until after we’ve exited the scope that `node` was allocated within, meaning `alloca` will free it & other stack data may overwrite it.
           -- We don’t evaluate `sourceSpan` eagerly so that terms which don’t use it don’t pay the toll for it. This places the onus for evaluating it on the termConstructor function.
           let info = range `seq` range .: categoriesForLanguage language (toS name) .: RNil
-          pure $! termConstructor (source blob) sourceSpan info children
+          termConstructor (source blob) sourceSpan info children
         getChild node n out = ts_node_p_named_child node n out >> toTerm out
         {-# INLINE getChild #-}