Don’t build call stacks.

src/Data/Syntax.hs

@@ -28,39 +28,39 @@ import GHC.Stack
 -- Combinators
 
 -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
-makeTerm :: (HasCallStack, f :< fs, Semigroup a, Apply Foldable fs) => a -> f (Term (Union fs) a) -> Term (Union fs) a
+makeTerm :: (f :< fs, Semigroup a, Apply Foldable fs) => a -> f (Term (Union fs) a) -> Term (Union fs) a
 makeTerm a = makeTerm' a . inj
 
 -- | Lift a union and an annotation into a term, ensuring the annotation encompasses all children.
-makeTerm' :: (HasCallStack, Semigroup a, Foldable f) => a -> f (Term f a) -> Term f a
+makeTerm' :: (Semigroup a, Foldable f) => a -> f (Term f a) -> Term f a
 makeTerm' a f = termIn (sconcat (a :| (termAnnotation . unTerm <$> toList f))) f
 
 -- | Lift non-empty syntax into a term, injecting the syntax into a union & appending all subterms’.annotations to make the new term’s annotation.
-makeTerm1 :: (HasCallStack, f :< fs, Semigroup a, Apply Foldable fs) => f (Term (Union fs) a) -> Term (Union fs) a
+makeTerm1 :: (f :< fs, Semigroup a, Apply Foldable fs) => f (Term (Union fs) a) -> Term (Union fs) a
 makeTerm1 = makeTerm1' . inj
 
 -- | Lift a non-empty union into a term, appending all subterms’.annotations to make the new term’s annotation.
-makeTerm1' :: (HasCallStack, Semigroup a, Foldable f) => f (Term f a) -> Term f a
+makeTerm1' :: (Semigroup a, Foldable f) => f (Term f a) -> Term f a
 makeTerm1' f = case toList f of
   a : _ -> makeTerm' (termAnnotation (unTerm a)) f
   _ -> error "makeTerm1': empty structure"
 
 -- | Construct an empty term at the current position.
-emptyTerm :: (HasCallStack, Empty :< fs, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
+emptyTerm :: (Empty :< fs, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
 emptyTerm = makeTerm . startLocation <$> Assignment.location <*> pure Empty
   where startLocation ann = Range (start (getField ann)) (start (getField ann)) :. Span (spanStart (getField ann)) (spanStart (getField ann)) :. Nil
 
 -- | Catch assignment errors into an error term.
-handleError :: (HasCallStack, Error :< fs, Enum grammar, Eq1 ast, Ix grammar, Show grammar, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location)) -> Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
+handleError :: (Error :< fs, Enum grammar, Eq1 ast, Ix grammar, Show grammar, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location)) -> Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
 handleError = flip catchError (\ err -> makeTerm <$> Assignment.location <*> pure (errorSyntax (either id show <$> err) []) <* Assignment.source)
 
 -- | Catch parse errors into an error term.
-parseError :: (HasCallStack, Error :< fs, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
+parseError :: (Error :< fs, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable fs) => Assignment.Assignment ast grammar (Term (Union fs) (Record Assignment.Location))
 parseError = makeTerm <$> Assignment.token maxBound <*> pure (Error (ErrorStack (getCallStack (freezeCallStack callStack))) [] (Just "ParseError") [])
 
 
 -- | Match context terms before a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term.
-contextualize :: (HasCallStack, Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
+contextualize :: (Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
               => m (Term (Union fs) a)
               -> m (Term (Union fs) a)
               -> m (Term (Union fs) a)
@@ -70,7 +70,7 @@ contextualize context rule = make <$> Assignment.manyThrough context rule
           _ -> node
 
 -- | Match context terms after a subject term and before a delimiter, returning the delimiter paired with a Context term if any context terms matched, or the subject term otherwise.
-postContextualizeThrough :: (HasCallStack, Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
+postContextualizeThrough :: (Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
                          => m (Term (Union fs) a)
                          -> m (Term (Union fs) a)
                          -> m b
@@ -81,7 +81,7 @@ postContextualizeThrough context rule end = make <$> rule <*> Assignment.manyThr
           _ -> (node, end)
 
 -- | Match context terms after a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term.
-postContextualize :: (HasCallStack, Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
+postContextualize :: (Context :< fs, Alternative m, Semigroup a, Apply Foldable fs)
                   => m (Term (Union fs) a)
                   -> m (Term (Union fs) a)
                   -> m (Term (Union fs) a)
@@ -91,7 +91,7 @@ postContextualize context rule = make <$> rule <*> many context
           _ -> node
 
 -- | Match infix terms separated by any of a list of operators, with optional context terms following each operand.
-infixContext :: (Context :< fs, Assignment.Parsing m, Semigroup a, HasCallStack, Apply Foldable fs)
+infixContext :: (Context :< fs, Assignment.Parsing m, Semigroup a, Apply Foldable fs)
              => m (Term (Union fs) a)
              -> m (Term (Union fs) a)
              -> m (Term (Union fs) a)

src/Language/JSON/Assignment.hs

@@ -14,7 +14,6 @@ import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Term as Term
 import Data.Union
-import GHC.Stack
 import Language.JSON.Grammar as Grammar
 
 type Syntax =
@@ -31,7 +30,7 @@ type Syntax =
   ]
 
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
+type Assignment = Assignment.Assignment [] Grammar Term
 
 
 assignment :: Assignment

src/Language/Markdown/Assignment.hs

@@ -18,7 +18,6 @@ import Data.Term as Term (Term(..), TermF(..), termIn, unwrap)
 import qualified Data.Text as Text
 import Data.Text.Encoding (encodeUtf8)
 import Data.Union
-import GHC.Stack
 import Language.Markdown as Grammar (Grammar(..))
 import qualified Language.Markdown.Syntax as Markup
 
@@ -51,7 +50,7 @@ type Syntax =
    ]
 
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment (TermF [] CMarkGFM.NodeType) Grammar Language.Markdown.Assignment.Term
+type Assignment = Assignment.Assignment (TermF [] CMarkGFM.NodeType) Grammar Language.Markdown.Assignment.Term
 
 
 assignment :: Assignment

src/Language/Python/Assignment.hs

@@ -22,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import qualified Data.Term as Term
 import Data.Union
-import GHC.Stack
 import Language.Python.Syntax as Python.Syntax
 import Language.Python.Grammar as Grammar
 
@@ -81,7 +80,7 @@ type Syntax =
    ]
 
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
+type Assignment = Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
 assignment :: Assignment
@@ -473,8 +472,7 @@ manyTermsTill :: Show b => Assignment.Assignment [] Grammar Term -> Assignment.A
 manyTermsTill step end = manyTill (step <|> comment) end
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: HasCallStack
+infixTerm :: Assignment
-          => Assignment
           -> Assignment
           -> [Assignment.Assignment [] Grammar (Term -> Term -> Union Syntax Term)]
           -> Assignment.Assignment [] Grammar (Union Syntax Term)

src/Language/Ruby/Assignment.hs

@@ -21,7 +21,6 @@ import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Term as Term
 import Data.Union
-import GHC.Stack
 import Language.Ruby.Grammar as Grammar
 
 -- | The type of Ruby syntax.
@@ -79,7 +78,7 @@ type Syntax = '[
   ]
 
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
+type Assignment = Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
 assignment :: Assignment
@@ -407,8 +406,7 @@ manyTermsTill :: Show b => Assignment.Assignment [] Grammar Term -> Assignment.A
 manyTermsTill step end = manyTill (step <|> comment) end
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: HasCallStack
+infixTerm :: Assignment
-          => Assignment
           -> Assignment
           -> [Assignment.Assignment [] Grammar (Term -> Term -> Union Syntax Term)]
           -> Assignment.Assignment [] Grammar (Union Syntax Term)

src/Language/TypeScript/Assignment.hs

@@ -20,7 +20,6 @@ import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import Data.Union
-import GHC.Stack
 import Language.TypeScript.Grammar as Grammar
 import qualified Language.TypeScript.Syntax as TypeScript.Syntax
 import qualified Data.Term as Term
@@ -282,7 +281,7 @@ anonymousClass = makeTerm <$> symbol Grammar.AnonymousClass <*> children (Declar
 abstractClass :: Assignment
 abstractClass = makeTerm <$> symbol Grammar.AbstractClass <*> (TypeScript.Syntax.AbstractClass <$> identifier <*> (typeParameters <|> emptyTerm) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
 
-classHeritage' :: HasCallStack => Assignment.Assignment [] Grammar [Term]
+classHeritage' :: Assignment.Assignment [] Grammar [Term]
 classHeritage' = symbol Grammar.ClassHeritage *> children (((++) `on` toList) <$> optional extendsClause' <*> optional implementsClause')
 
 extendsClause' :: Assignment
@@ -389,7 +388,7 @@ methodDefinition = makeMethod <$>
   where
     makeMethod loc (modifier, readonly, receiver, propertyName', (typeParameters', params, ty'), statements) = makeTerm loc (Declaration.Method [modifier, readonly, typeParameters', ty'] receiver propertyName' params statements)
 
-callSignatureParts :: HasCallStack => Assignment.Assignment [] Grammar (Term, [Term], Term)
+callSignatureParts :: Assignment.Assignment [] Grammar (Term, [Term], Term)
 callSignatureParts =  symbol Grammar.CallSignature *> children ((,,) <$> (fromMaybe <$> emptyTerm <*> optional typeParameters) <*> formalParameters <*> (fromMaybe <$> emptyTerm <*> optional typeAnnotation'))
 
 callSignature :: Assignment
@@ -405,7 +404,7 @@ methodSignature :: Assignment
 methodSignature = makeMethodSignature <$> symbol Grammar.MethodSignature <*> children ((,,,) <$> (accessibilityModifier' <|> emptyTerm) <*> (readonly' <|> emptyTerm) <*> propertyName <*> callSignatureParts)
   where makeMethodSignature loc (modifier, readonly, propertyName, (typeParams, params, annotation)) = makeTerm loc (TypeScript.Syntax.MethodSignature [modifier, readonly, typeParams, annotation] propertyName params)
 
-formalParameters :: HasCallStack => Assignment.Assignment [] Grammar [Term]
+formalParameters :: Assignment.Assignment [] Grammar [Term]
 formalParameters = symbol FormalParameters *> children (concat <$> many ((\as b -> as ++ [b]) <$> many (term decorator) <*> term parameter))
 
 decorator :: Assignment
@@ -503,7 +502,7 @@ constructorTy = makeTerm <$> symbol ConstructorType <*> children (TypeScript.Syn
 statementBlock :: Assignment
 statementBlock = makeTerm <$> symbol StatementBlock <*> children (many statement)
 
-classBodyStatements :: HasCallStack => Assignment.Assignment [] Grammar [Term]
+classBodyStatements :: Assignment.Assignment [] Grammar [Term]
 classBodyStatements = symbol ClassBody *> children (concat <$> many ((\as b -> as ++ [b]) <$> many (term decorator) <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature)))
 
 publicFieldDefinition :: Assignment
@@ -671,7 +670,7 @@ module' :: Assignment
 module' = makeTerm <$> symbol Module <*> children (Declaration.Module <$> (string <|> identifier <|> nestedIdentifier) <*> ((symbol StatementBlock *> children (many statement)) <|> pure []))
 
 
-statements :: HasCallStack => Assignment.Assignment [] Grammar [Term]
+statements :: Assignment.Assignment [] Grammar [Term]
 statements = symbol StatementBlock *> children (many statement)
 
 arrowFunction :: Assignment
@@ -754,8 +753,7 @@ emptyStatement :: Assignment
 emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty)
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: HasCallStack
+infixTerm :: Assignment
-          => Assignment
           -> Assignment
           -> [Assignment.Assignment [] Grammar (Term -> Term -> Data.Union.Union Syntax Term)]
           -> Assignment.Assignment [] Grammar (Data.Union.Union Syntax Term)