Remove the leaf type parameter from SyntaxTerm.

src/Interpreter.hs

@@ -24,7 +24,7 @@ import Term
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
 diffTerms :: HasField fields Category
-          => Both (SyntaxTerm leaf fields) -- ^ A pair of terms representing the old and new state, respectively.
+          => Both (SyntaxTerm fields) -- ^ A pair of terms representing the old and new state, respectively.
           -> SyntaxDiff leaf fields
 diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
@@ -62,9 +62,9 @@ getLabel (h :< t) = (Info.category h, case t of
 
 
 -- | Construct an algorithm to diff a pair of terms.
-algorithmWithTerms :: SyntaxTerm leaf fields
-                   -> SyntaxTerm leaf fields
-                   -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) (SyntaxDiff leaf fields)
+algorithmWithTerms :: SyntaxTerm fields
+                   -> SyntaxTerm fields
+                   -> Algorithm (SyntaxTerm fields) (SyntaxDiff leaf fields) (SyntaxDiff leaf fields)
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b

src/Language.hs

@@ -53,13 +53,13 @@ toTuple child | S.Fixed [key,value] <- unwrap child = [cofree (extract child :<
 toTuple child | S.Leaf c <- unwrap child = [cofree (extract child :< S.Comment c)]
 toTuple child = pure child
 
-toPublicFieldDefinition :: HasField fields Category => [SyntaxTerm Text fields] -> Maybe (S.Syntax (SyntaxTerm Text fields))
+toPublicFieldDefinition :: HasField fields Category => [SyntaxTerm fields] -> Maybe (S.Syntax (SyntaxTerm fields))
 toPublicFieldDefinition children = case break (\x -> category (extract x) == Identifier) children of
   (prev, [identifier, assignment]) -> Just $ S.VarAssignment (prev ++ [identifier]) assignment
   (_, [_]) -> Just $ S.VarDecl children
   _ -> Nothing
 
-toInterface :: HasField fields Category => [SyntaxTerm Text fields] -> Maybe (S.Syntax (SyntaxTerm Text fields))
+toInterface :: HasField fields Category => [SyntaxTerm fields] -> Maybe (S.Syntax (SyntaxTerm fields))
 toInterface (id : rest) = case break (\x -> category (extract x) == Other "object_type") rest of
   (clauses, [body]) -> Just $ S.Interface id clauses (toList (unwrap body))
   _ -> Nothing

src/Language/C.hs

@@ -10,8 +10,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm Text DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm Text DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
 termAssignment _ _ _ = Nothing
 
 

src/Language/Go.hs

@@ -10,8 +10,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm Text DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm Text DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
 termAssignment source category children = case (category, children) of
   (Module, [moduleName]) -> Just $ S.Module moduleName []
   (Import, [importName]) -> Just $ S.Import importName []

src/Language/Ruby.hs

@@ -12,8 +12,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm Text DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm Text DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
 termAssignment _ category children
   = case (category, children) of
     (ArgumentPair, [ k, v ] ) -> Just $ S.Pair k v

src/Language/TypeScript.hs

@@ -11,8 +11,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm Text DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm Text DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
 termAssignment _ category children =
   case (category, children) of
     (Assignment, [ identifier, value ]) -> Just $ S.Assignment identifier value

src/Parser.hs

@@ -48,14 +48,14 @@ data Parser term where
                    -> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.
                    -> Parser (Term (Union fs) (Record Location))                 -- ^ A parser producing 'Term's.
   -- | A tree-sitter parser.
-  TreeSitterParser :: Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
+  TreeSitterParser :: Ptr TS.Language -> Parser (SyntaxTerm DefaultFields)
   -- | A parser for 'Markdown' using cmark.
   MarkdownParser :: Parser (AST CMark.NodeType)
   -- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
-  LineByLineParser :: Parser (SyntaxTerm Text DefaultFields)
+  LineByLineParser :: Parser (SyntaxTerm DefaultFields)
 
 -- | Return a 'Language'-specific 'Parser', if one exists, falling back to the 'LineByLineParser'.
-parserForLanguage :: Maybe Language -> Parser (SyntaxTerm Text DefaultFields)
+parserForLanguage :: Maybe Language -> Parser (SyntaxTerm DefaultFields)
 parserForLanguage Nothing = LineByLineParser
 parserForLanguage (Just language) = case language of
   C -> TreeSitterParser tree_sitter_c
@@ -80,6 +80,6 @@ markdownParser = AssignmentParser MarkdownParser (\ (node@Node{..} :< _) -> node
 
 
 -- | A fallback parser that treats a file simply as rows of strings.
-lineByLineParser :: Source -> SyntaxTerm Text DefaultFields
+lineByLineParser :: Source -> SyntaxTerm DefaultFields
 lineByLineParser source = cofree $ (totalRange source :. Program :. totalSpan source :. Nil) :< Indexed (zipWith toLine [1..] (sourceLineRanges source))
   where toLine line range = cofree $ (range :. Program :. Span (Pos line 1) (Pos line (end range)) :. Nil) :< Leaf (toText (slice range source))

src/Renderer.hs

@@ -56,7 +56,7 @@ data TermRenderer output where
   -- | Render to a 'ByteString' formatted as nested s-expressions.
   SExpressionTermRenderer :: TermRenderer ByteString
   -- | “Render” by returning the computed 'SyntaxTerm'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for SemanticSpec.hs.
-  IdentityTermRenderer :: TermRenderer (Maybe (SyntaxTerm Text DefaultFields))
+  IdentityTermRenderer :: TermRenderer (Maybe (SyntaxTerm DefaultFields))
 
 deriving instance Eq (TermRenderer output)
 deriving instance Show (TermRenderer output)

src/Renderer/TOC.hs

@@ -93,7 +93,7 @@ declaration (annotation :< _) = annotation <$ (getField annotation :: Maybe Decl
 
 
 -- | Compute 'Declaration's for methods and functions in 'Syntax'.
-syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (SyntaxTermF Text fields) (SyntaxTerm Text fields) (Maybe Declaration)
+syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (SyntaxTermF fields) (SyntaxTerm fields) (Maybe Declaration)
 syntaxDeclarationAlgebra Blob{..} r = case tailF r of
   S.Function (identifier, _) _ _ -> Just $ FunctionDeclaration (getSource identifier)
   S.Method _ (identifier, _) Nothing _ _ -> Just $ MethodDeclaration (getSource identifier)

src/Term.hs

@@ -14,8 +14,8 @@ type Term f = Cofree f
 type TermF = CofreeF
 
 -- | A Term with a Syntax leaf and a record of fields.
-type SyntaxTerm leaf fields = Term Syntax (Record fields)
-type SyntaxTermF leaf fields = TermF Syntax (Record fields)
+type SyntaxTerm fields = Term Syntax (Record fields)
+type SyntaxTermF fields = TermF Syntax (Record fields)
 
 instance (NFData (f (Cofree f a)), NFData a, Functor f) => NFData (Cofree f a) where
   rnf = rnf . runCofree

src/TreeSitter.hs

@@ -34,7 +34,7 @@ import qualified Text.Parser.TreeSitter.TypeScript as TS
 import Info
 
 -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
-treeSitterParser :: Ptr TS.Language -> Blob -> IO (SyntaxTerm Text DefaultFields)
+treeSitterParser :: Ptr TS.Language -> Blob -> IO (SyntaxTerm DefaultFields)
 treeSitterParser language blob = bracket ts_document_new ts_document_free $ \ document -> do
   ts_document_set_language document language
   unsafeUseAsCStringLen (sourceBytes (blobSource blob)) $ \ (sourceBytes, len) -> do
@@ -70,13 +70,13 @@ anaM g = a where a = pure . embed <=< traverse a <=< g
 
 
 -- | Return a parser for a tree sitter language & document.
-documentToTerm :: Ptr TS.Language -> Ptr Document -> Blob -> IO (SyntaxTerm Text DefaultFields)
+documentToTerm :: Ptr TS.Language -> Ptr Document -> Blob -> IO (SyntaxTerm DefaultFields)
 documentToTerm language document Blob{..} = do
   root <- alloca (\ rootPtr -> do
     ts_document_root_node_p document rootPtr
     peek rootPtr)
   toTerm root
-  where toTerm :: Node -> IO (SyntaxTerm Text DefaultFields)
+  where toTerm :: Node -> IO (SyntaxTerm DefaultFields)
         toTerm node = do
           name <- peekCString (nodeType node)
 
@@ -95,7 +95,7 @@ documentToTerm language document Blob{..} = do
         copyNamed = ts_node_copy_named_child_nodes document
         copyAll = ts_node_copy_child_nodes document
 
-isNonEmpty :: HasField fields Category => SyntaxTerm Text fields -> Bool
+isNonEmpty :: HasField fields Category => SyntaxTerm fields -> Bool
 isNonEmpty = (/= Empty) . category . extract
 
 nodeRange :: Node -> Range
@@ -105,12 +105,12 @@ nodeSpan :: Node -> Span
 nodeSpan Node{..} = nodeStartPoint `seq` nodeEndPoint `seq` Span (pointPos nodeStartPoint) (pointPos nodeEndPoint)
   where pointPos TSPoint{..} = pointRow `seq` pointColumn `seq` Pos (1 + fromIntegral pointRow) (1 + fromIntegral pointColumn)
 
-assignTerm :: Ptr TS.Language -> Source -> Record DefaultFields -> [ SyntaxTerm Text DefaultFields ] -> IO [ SyntaxTerm Text DefaultFields ] -> IO (SyntaxTerm Text DefaultFields)
+assignTerm :: Ptr TS.Language -> Source -> Record DefaultFields -> [ SyntaxTerm DefaultFields ] -> IO [ SyntaxTerm DefaultFields ] -> IO (SyntaxTerm DefaultFields)
 assignTerm language source annotation children allChildren =
   cofree . (annotation :<) <$> case assignTermByLanguage source (category annotation) children of
     Just a -> pure a
     _ -> defaultTermAssignment source (category annotation) children allChildren
-  where assignTermByLanguage :: Source -> Category -> [ SyntaxTerm Text DefaultFields ] -> Maybe (S.Syntax (SyntaxTerm Text DefaultFields))
+  where assignTermByLanguage :: Source -> Category -> [ SyntaxTerm DefaultFields ] -> Maybe (S.Syntax (SyntaxTerm DefaultFields))
         assignTermByLanguage = case languageForTSLanguage language of
           Just C -> C.termAssignment
           Just Language.Go -> Go.termAssignment
@@ -118,7 +118,7 @@ assignTerm language source annotation children allChildren =
           Just TypeScript -> TS.termAssignment
           _ -> \ _ _ _ -> Nothing
 
-defaultTermAssignment :: Source -> Category -> [ SyntaxTerm Text DefaultFields ] -> IO [ SyntaxTerm Text DefaultFields ] -> IO (S.Syntax (SyntaxTerm Text DefaultFields))
+defaultTermAssignment :: Source -> Category -> [ SyntaxTerm DefaultFields ] -> IO [ SyntaxTerm DefaultFields ] -> IO (S.Syntax (SyntaxTerm DefaultFields))
 defaultTermAssignment source category children allChildren
   | category `elem` operatorCategories = S.Operator <$> allChildren
   | otherwise = pure $! case (category, children) of

test/Data/RandomWalkSimilarity/Spec.hs

@@ -23,19 +23,19 @@ spec = parallel $ do
   let positively = succ . abs
   describe "pqGramDecorator" $ do
     prop "produces grams with stems of the specified length" $
-      \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (unListableF term :: SyntaxTerm String '[Category]) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
+      \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (unListableF term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
 
     prop "produces grams with bases of the specified width" $
-      \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (unListableF term :: SyntaxTerm String '[Category]) `shouldSatisfy` all ((== positively q) . length . base . rhead)
+      \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (unListableF term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== positively q) . length . base . rhead)
 
   describe "featureVectorDecorator" $ do
     prop "produces a vector of the specified dimension" $
-      \ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (unListableF term :: SyntaxTerm String '[Category]) `shouldSatisfy` all ((== (0, abs d)) . bounds . rhead)
+      \ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (unListableF term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== (0, abs d)) . bounds . rhead)
 
   describe "rws" $ do
     prop "produces correct diffs" $
-      \ (as, bs) -> let tas = decorate <$> (unListableF <$> as :: [SyntaxTerm String '[Category]])
-                        tbs = decorate <$> (unListableF <$> bs :: [SyntaxTerm String '[Category]])
+      \ (as, bs) -> let tas = decorate <$> (unListableF <$> as :: [SyntaxTerm '[Category]])
+                        tbs = decorate <$> (unListableF <$> bs :: [SyntaxTerm '[Category]])
                         root = cofree . ((Program :. Nil) :<) . Indexed
                         diff = wrap (pure (Program :. Nil) :< Indexed (stripDiff . diffThese <$> rws editDistance canCompare tas tbs)) in
         (beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
@@ -46,7 +46,7 @@ spec = parallel $ do
 
   where canCompare a b = headF a == headF b
 
-        decorate :: SyntaxTerm leaf '[Category] -> SyntaxTerm leaf '[FeatureVector, Category]
+        decorate :: SyntaxTerm '[Category] -> SyntaxTerm '[FeatureVector, Category]
         decorate = defaultFeatureVectorDecorator (category . headF)
 
         diffThese = these deleting inserting replacing

test/DiffSpec.hs

@@ -23,15 +23,15 @@ spec = parallel $ do
       diff `shouldBe` diff
 
   prop "equal terms produce identity diffs" $
-    \ a -> let term = decorate (unListableF a :: SyntaxTerm String '[Category]) in
+    \ a -> let term = decorate (unListableF a :: SyntaxTerm '[Category]) in
       diffCost (diffTerms (pure term)) `shouldBe` 0
 
   describe "beforeTerm" $ do
     prop "recovers the before term" $
-      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm String '[Category])) in
+      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
         beforeTerm diff `shouldBe` Just (unListableF a)
 
   describe "afterTerm" $ do
     prop "recovers the after term" $
-      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm String '[Category])) in
+      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
         afterTerm diff `shouldBe` Just (unListableF b)

test/InterpreterSpec.hs

@@ -26,15 +26,15 @@ spec = parallel $ do
           diffTerms (both termA termB) `shouldBe` replacing termA termB
 
     prop "produces correct diffs" $
-      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm String '[Category])) in
+      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
                    (beforeTerm diff, afterTerm diff) `shouldBe` (Just (unListableF a), Just (unListableF b))
 
     prop "constructs zero-cost diffs of equal terms" $
-      \ a -> let term = (unListableF a :: SyntaxTerm String '[Category])
+      \ a -> let term = (unListableF a :: SyntaxTerm '[Category])
                  diff = diffTerms (pure term) in
                  diffCost diff `shouldBe` 0
 
     it "produces unbiased insertions within branches" $
-      let term s = cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf s) ]) :: SyntaxTerm String '[Category]
+      let term s = cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf s) ]) :: SyntaxTerm '[Category]
           root = cofree . ((Program :. Nil) :<) . Indexed in
       diffTerms (both (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program :. Nil) :< Indexed [ inserting (term "a"), cata wrap (fmap pure (term "b")) ])

test/TOCSpec.hs

@@ -156,7 +156,7 @@ spec = parallel $ do
 
 
 type Diff' = SyntaxDiff Text (Maybe Declaration ': DefaultFields)
-type Term' = SyntaxTerm Text (Maybe Declaration ': DefaultFields)
+type Term' = SyntaxTerm (Maybe Declaration ': DefaultFields)
 
 numTocSummaries :: Diff' -> Int
 numTocSummaries diff = length $ filter isValidSummary (diffTOC diff)

test/TermSpec.hs

@@ -14,4 +14,4 @@ spec :: Spec
 spec = parallel $ do
   describe "Term" $ do
     prop "equality is reflexive" $
-      \ a -> unListableF a `shouldBe` (unListableF a :: SyntaxTerm String '[Category])
+      \ a -> unListableF a `shouldBe` (unListableF a :: SyntaxTerm '[Category])