diff --git a/exe/newman.hs b/exe/newman.hs
new file mode 100644
--- /dev/null
+++ b/exe/newman.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Pinchot.Examples.Newman
+import System.Environment (getArgs)
+
+main :: IO ()
+main = do
+  a1:[] <- getArgs
+  address a1
diff --git a/exe/parakeet.hs b/exe/parakeet.hs
deleted file mode 100644
--- a/exe/parakeet.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedLists #-}
-
--- | Like @parrot@ but uses
--- 'Pinchot.Examples.EarleyProduct.addressParser'.
--- 
--- Reads the string given as the first argument.  Parses it and
--- then, for each parse result, uses 'terminals' to print the
--- terminals.  Each result output should be the same as the input.
-module Main where
-
-import Data.Foldable (toList)
-import Pinchot
-import Pinchot.Examples.Postal
-import Pinchot.Examples.EarleyProduct
-import Pinchot.Examples.PostalAstAllRules
-import System.Environment (getArgs)
-
-import Text.Earley (parser, fullParses)
-
-main :: IO ()
-main = do
-  a1:[] <- getArgs
-  let (ls, _) = fullParses (parser addressParser) a1
-      printSeq = putStrLn . toList . t'Address
-  mapM_ printSeq ls
diff --git a/exe/parrot.hs b/exe/parrot.hs
deleted file mode 100644
--- a/exe/parrot.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TemplateHaskell #-}
-
--- Reads the string given as the first argument.  Parses it and
--- then, for each parse result, uses 't'Address' to print the
--- terminals.  Each result output should be the same as the input.
-module Main where
-
-import Pinchot
-import Data.Foldable (toList)
-import Pinchot.Examples.Postal
-import Pinchot.Examples.EarleyProduct
-import System.Environment (getArgs)
-
-import Text.Earley (parser, fullParses)
-
-ruleTreeToTypes noOptics ''Char [] postal
-
-main :: IO ()
-main = do
-  a1:[] <- getArgs
-  let (ls, _) = fullParses (parser $(earleyGrammar "" postal)) a1 
-      printSeq = putStrLn . toList . t'Address
-  mapM_ printSeq ls
diff --git a/exe/postal-parser.hs b/exe/postal-parser.hs
deleted file mode 100644
--- a/exe/postal-parser.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverloadedLists #-}
-
--- | Creates a Template Haskell parser.  Parses strings in the postal
--- language and pretty-prints the result.
-module Main where
-
-import Pinchot
-import Pinchot.Examples.Postal
-import System.Environment (getArgs)
-import Text.Show.Pretty (ppShow)
-
-import Text.Earley (Prod, Grammar, parser, fullParses)
-
-ruleTreeToTypes makeOptics ''Char [''Show] postal
-
-postalGrammar :: Grammar r (Prod r String Char Address)
-postalGrammar = $(earleyGrammar "" postal)
-
-main :: IO ()
-main = do
-  a1:[] <- getArgs
-  putStrLn . ppShow $ fullParses (parser postalGrammar) a1
diff --git a/exe/print-postal-grammar.hs b/exe/print-postal-grammar.hs
deleted file mode 100644
--- a/exe/print-postal-grammar.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wall #-}
-
--- | Creates a Template Haskell AST for a parser
--- and pretty-prints it to standard output.
-module Main where
-
-import Language.Haskell.TH
-import Pinchot
-import Pinchot.Examples.Postal
-
-
-main :: IO ()
-main = runQ [| $(earleyGrammar "" postal) |] >>= putStrLn . pprint
diff --git a/lib/Pinchot.hs b/lib/Pinchot.hs
--- a/lib/Pinchot.hs
+++ b/lib/Pinchot.hs
@@ -1,13 +1,17 @@
 {- |
 
 Pinchot provides a simple language that you use to write a Haskell
-program that describes a context-free grammar.  When run, this program
-creates a value that stores your context-free grammar.  You can then
+values that describes a context-free grammar.  You can then
 use Template Haskell to take this value and generate a series of data
 types that correspond to your context-free grammar.  You can also use
 Template Haskell to create an Earley parser that will parse all
-strings in the context-free language.
+strings in the context-free language.  Other handy utilities generate
+functions that will return all the terminal characters from a parsed
+production rule.  It is also possible to easily determine the location
+(line, column, and position) of any parsed production or character.
 
+Everything you typically need should be in this module.
+
 For examples, please consult "Pinchot.Examples".
 
 You should also look at the BNF Converter.
@@ -43,40 +47,73 @@
   , solo
   , pariah
 
-  -- * Simple production rules
-  , Pinchot
+  -- * Non-empty
+  , NonEmpty(..)
+  , front
+  , rest
+  , flatten
+  , seqToNonEmpty
+  , prependSeq
+  , appendSeq
+  , append
+  , singleton
+  
+  -- * Production rules
   , RuleName
-  , AlternativeName
   , Rule
+  , BranchName
   , terminal
-  , terminalSeq
   , nonTerminal
   , union
+  , terminals
+  , wrap
   , record
+  , opt
+  , star
+  , plus
 
-  -- * Rules that modify other rules
-  , list
-  , list1
-  , option
-  , wrap
+  -- ** Errors
   , label
   , (<?>)
 
-  -- * Transforming a Pinchot value to code
-  -- ** Creating data types
-  , MakeOptics
-  , makeOptics
-  , noOptics
-  , allRulesToTypes
-  , ruleTreeToTypes
+  -- * Qualifiers
+  , Qualifier
+
+  -- * Creating data types corresponding to grammars
+  , syntaxTrees
   , allRulesRecord
 
-  -- ** Creating Earley grammars
-  , Qualifier
-  , earleyGrammar
-  , allEarleyGrammars
+  -- ** Wrappers and optics
+  , wrappedInstances
+  , rulesToOptics
+
+  -- * Creating Earley grammars
+  , earleyGrammarFromRule
   , earleyProduct
+
+  -- * Terminalizers
+  , terminalizeRuleExp
+  , terminalizers
+
+  -- * Locations
+  , Loc(..)
+  , line
+  , col
+  , pos
+  , locations
+  , noLocations
+
+  -- * Running parsers with locations
+  , locatedFullParses
   ) where
 
-import Pinchot.Internal
+import Pinchot.Earley
+import Pinchot.Locator
 import Pinchot.Intervals
+import Pinchot.NonEmpty
+import Pinchot.Rules
+import Pinchot.SyntaxTree
+import Pinchot.SyntaxTree.Optics
+import Pinchot.SyntaxTree.Wrappers
+import Pinchot.Terminalize
+import Pinchot.Types
diff --git a/lib/Pinchot/Earley.hs b/lib/Pinchot/Earley.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Earley.hs
@@ -0,0 +1,248 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- | Creating Earley parsers.
+
+module Pinchot.Earley where
+
+import Pinchot.NonEmpty
+import Pinchot.RecursiveDo
+import Pinchot.Rules
+import Pinchot.Types
+import Pinchot.Intervals
+
+import Control.Applicative ((<|>), liftA2)
+import Data.Foldable (toList)
+import Data.Sequence ((<|), viewl, ViewL(EmptyL, (:<)), Seq)
+import qualified Data.Sequence as Seq
+import qualified Language.Haskell.TH as T
+import qualified Language.Haskell.TH.Syntax as Syntax
+import qualified Text.Earley
+
+-- | Creates a list of pairs.  Each list represents a statement in
+-- @do@ notation.  The first element of the pair is the name of the
+-- variable to which to bind the result of the expression, which is
+-- the second element of the pair.
+ruleToParser
+  :: Syntax.Lift t
+  => String
+  -- ^ Module prefix
+  -> Rule t
+  -> [(T.Name, T.ExpQ)]
+ruleToParser prefix (Rule nm mayDescription rt) = case rt of
+
+  Terminal ivls -> [makeRule expression]
+    where
+      expression =
+        [| let f (c, a)
+                | inIntervals ivls c = Just
+                    ($(T.conE (quald prefix nm)) (c, a))
+                | otherwise = Nothing
+           in Text.Earley.terminal f |]
+
+  NonTerminal b1 bs -> [makeRule expression]
+    where
+      expression = foldl addBranch (branchToParser prefix b1) bs
+        where
+          addBranch tree branch =
+            [| $tree <|> $(branchToParser prefix branch) |]
+
+  Wrap (Rule innerNm _ _) -> [makeRule expression]
+    where
+      expression = [|fmap $constructor $(T.varE (localRuleName innerNm)) |]
+
+  Record sq -> [makeRule expression]
+    where
+      expression = case viewl sq of
+        EmptyL -> [| pure $constructor |]
+        Rule r1 _ _ :< restFields -> foldl addField fstField restFields
+          where
+            fstField = [| $constructor <$> $(T.varE (localRuleName r1)) |]
+            addField soFar (Rule r _ _)
+              = [| $soFar <*> $(T.varE (localRuleName r)) |]
+    
+  Opt (Rule innerNm _ _) -> [makeRule expression]
+    where
+      expression = [| fmap $constructor (pure Nothing <|> $(just)) |]
+        where
+          just = [| fmap Just $(T.varE (localRuleName innerNm)) |]
+
+  Star (Rule innerNm _ _) -> [nestRule, makeRule (wrapper helper)]
+    where
+      nestRule = (helper, ([|Text.Earley.rule|] `T.appE` parseSeq))
+        where
+          parseSeq = T.uInfixE [|pure Seq.empty|] [|(<|>)|] pSeq
+            where
+              pSeq = [|liftA2 (<|)
+                $(T.varE (localRuleName innerNm)) $(T.varE helper) |]
+
+  Plus (Rule innerNm _ _) -> [nestRule, makeRule topExpn]
+    where
+      nestRule = (helper, [|Text.Earley.rule $(parseSeq)|])
+        where
+          parseSeq = [| pure Seq.empty <|> $pSeq |]
+            where
+              pSeq = [| (<|) <$> $(T.varE (localRuleName innerNm))
+                             <*> $(T.varE helper) |]
+      topExpn = [| $constructor <$>
+        ( NonEmpty <$> $(T.varE (localRuleName innerNm))
+                   <*> $(T.varE helper)) |]
+
+
+  where
+    makeRule expression = (localRuleName nm,
+      [|Text.Earley.rule ($expression Text.Earley.<?> $(textToExp desc))|])
+    desc = maybe nm id mayDescription
+    textToExp txt = [| $(Syntax.lift txt) |]
+    constructor = T.conE (quald prefix nm)
+    wrapper wrapRule = [|fmap $constructor $(T.varE wrapRule) |]
+    helper = helperName nm
+
+localRuleName :: String -> T.Name
+localRuleName suffix = T.mkName ("_rule'" ++ suffix)
+
+helperName :: String -> T.Name
+helperName suffix = T.mkName ("_helper'" ++ suffix)
+
+branchToParser
+  :: Syntax.Lift t
+  => String
+  -- ^ Module prefix
+  -> Branch t
+  -> T.ExpQ
+branchToParser prefix (Branch name rules) = case viewl rules of
+  EmptyL -> [| pure $constructor |]
+  (Rule rule1 _ _) :< xs -> foldl f z xs
+    where
+      z = [| $constructor <$> $(T.varE (localRuleName rule1)) |]
+      f soFar (Rule rule2 _ _) = [| $soFar <*> $(T.varE (localRuleName rule2)) |]
+  where
+    constructor = T.conE (quald prefix name)
+
+-- | Creates an expression that has type
+--
+-- 'Text.Earley.Grammar' r (Prod r String (c, a) (p c a))
+--
+-- where @r@ is left universally quantified; @c@ is the terminal
+-- type (often 'Char'), @a@ is arbitrary metadata about each token
+-- (often 'Loc') and @p@ is the data type corresponding to
+-- the given 'Rule'.
+--
+-- Example:  'Pinchot.Examples.Earley.addressGrammar'.
+earleyGrammarFromRule
+  :: Syntax.Lift t
+  => Qualifier
+  -- ^ Module prefix holding the data types created with
+  -- 'Pinchot.syntaxTrees'
+  -> Rule t
+  -- ^ Create a grammar for this 'Rule'
+  -> T.Q T.Exp
+earleyGrammarFromRule prefix r@(Rule top _ _) = recursiveDo binds final
+  where
+    binds = concatMap (ruleToParser prefix) . toList . family $ r
+    final = [| return $(T.varE $ localRuleName top) |]
+
+-- | Creates a record data type that holds a value of type
+--
+-- @'Text.Earley.Prod' r 'String' (t, a) (p t a)@
+--
+-- where
+--
+-- * @r@ is left universally quantified
+--
+-- * @t@ is the token type (often 'Char')
+--
+-- * @a@ is any additional information about each token (often
+-- 'Pinchot.Loc')
+--
+-- * @p@ is the type of the particular production
+--
+-- This always creates a single product type whose name is
+-- @Productions@; currently the name cannot be configured.
+--
+-- Example: "Pinchot.Examples.SyntaxTrees".
+allRulesRecord
+  :: Qualifier
+  -- ^ Qualifier for data types corresponding to those created from
+  -- the 'Rule's
+  -> T.Name
+  -- ^ Name of terminal type.  Typically you will get this through
+  -- the Template Haskell quoting mechanism, such as @''Char@.
+  -> Seq (Rule t)
+  -- ^ A record is created that holds a value for each 'Rule'
+  -- in the 'Seq', as well as for every ancestor of these 'Rule's.
+  -> T.DecsQ
+  -- ^ When spliced, this will create a single declaration that is a
+  -- record with the name @Productions@.
+  --
+  -- @a'NAME@
+  --
+  -- where @NAME@ is the name of the type.  Don't count on these
+  -- records being in any particular order.
+allRulesRecord prefix termName ruleSeq
+  = sequence [T.dataD (return []) (T.mkName nameStr) tys [con] []]
+  where
+    nameStr = "Productions"
+    tys = [T.PlainTV (T.mkName "r"), T.PlainTV (T.mkName "t"),
+      T.PlainTV (T.mkName "a")]
+    con = T.recC (T.mkName nameStr)
+        (fmap mkRecord . toList . families $ ruleSeq)
+    mkRecord (Rule ruleNm _ _) = T.varStrictType recName st
+      where
+        recName = T.mkName ("a'" ++ ruleNm)
+        st = T.strictType T.notStrict ty
+          where
+            ty = [t| Text.Earley.Prod $(T.varT (T.mkName "r"))
+                      String
+                      ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")))
+                      ( $(T.conT (T.mkName nameWithPrefix))
+                            $(T.varT (T.mkName "t"))
+                            $(T.varT (T.mkName "a"))) |]
+            nameWithPrefix = case prefix of
+              [] -> ruleNm
+              _ -> prefix ++ '.' : ruleNm
+
+-- | Creates a 'Text.Earley.Grammar' that contains a
+-- 'Text.Earley.Prod' for every given 'Rule' and its ancestors.
+-- Example: 'Pinchot.Examples.Earley.addressAllProductions'.
+earleyProduct
+  :: Syntax.Lift t
+
+  => Qualifier
+  -- ^ Qualifier for data types corresponding to those created from
+  -- the 'Rule's
+
+  -> Qualifier
+  -- ^ Qualifier for the type created with 'allRulesRecord'
+
+  -> Seq (Rule t)
+  -- ^ Creates an Earley grammar that contains a 'Text.Earley.Prod'
+  -- for each 'Rule' in this 'Seq', as well as all the ancestors of
+  -- these 'Rule's.
+
+  -> T.ExpQ
+  -- ^ When spliced, 'earleyProduct' creates an expression whose
+  -- type is @'Text.Earley.Grammar' r (Productions r t a)@, where
+  -- @Productions@ is
+  -- the type created by 'allRulesRecord'; @r@ is left universally
+  -- quantified; @t@ is the token type (often 'Char'), and @a@ is
+  -- any additional information about each token (often
+  -- 'Pinchot.Loc').
+earleyProduct pfxRule pfxRec ruleSeq = do
+  let binds = concatMap (ruleToParser pfxRule)
+        . toList . families $ ruleSeq
+      final = [| return
+        $(T.recConE (T.mkName rulesRecName)
+                    (fmap mkRec . toList . families $ ruleSeq)) |]
+        
+  recursiveDo binds final
+  where
+    rulesRecName
+      | null pfxRec = "Productions"
+      | otherwise = pfxRec ++ ".Productions"
+    mkRec (Rule n _ _) = return (T.mkName recName, recVal)
+      where
+        recName
+          | null pfxRec = "a'" ++ n
+          | otherwise = pfxRec ++ ".a'" ++ n
+        recVal = T.VarE . localRuleName $ n
+
diff --git a/lib/Pinchot/Examples.hs b/lib/Pinchot/Examples.hs
--- a/lib/Pinchot/Examples.hs
+++ b/lib/Pinchot/Examples.hs
@@ -1,44 +1,28 @@
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- | Examples for the use of Pinchot.
--- You wil want to look at the source code for the modules; examining
--- just the Haddocks shows you the code that the Template Haskell
--- ultimately generates.
---
--- In "Pinchot.Examples.Postal" is an example grammar for US postal
--- addresses.
---
--- "Pinchot.Examples.PostalAstAllRules" shows you how to use
--- 'allRulesToTypes' and 'earleyGrammar', while
--- "Pinchot.Examples.PostalAstRuleTree" shows you how to use
--- 'ruleTreeToTypes' and 'earleyGrammar'.
---
--- "Pinchot.Examples.AllEarleyGrammars" shows you how to use
--- 'allEarleyGrammars'.
---
--- "Pinchot.Examples.AllRulesRecord" and
--- "Pinchot.Examples.EarleyProduct" show you how to use
--- 'allRulesRecord' and 'earleyProduct'.
---
--- Three executables are included in the @pinchot@ package.  To get
--- them, compile @pinchot@ with the @executables@ Cabal flag.
+-- | Examples for Pinchot are in this hierarchy.  Start out with
+-- "Pinchot.Examples.Postal", which contains a sample grammar.
+-- Next, "Pinchot.Examples.SyntaxTrees" shows you how to convert
+-- your grammar to data types, and "Pinchot.Examples.AllRulesRecord"
+-- shows how to make a product type holding an Earley
+-- 'Text.Earley.Prod' for every 'Rule' in your grammar.  Then,
+-- "Pinchot.Earley" shows how to generate the Earley
+-- 'Text.Earley.Grammar' you need to actually parse strings.
 --
--- The @print-postal-grammar@ executable will pretty print the Haskell
--- source that results from applying 'earleyGrammar' to the 'postal'
--- grammar.
+-- "Pinchot.Examples.Terminalize" shows you how to generate data
+-- types that will reduce any 'Rule' to the sequence of terminal
+-- tokens from which it came.  This can be useful not only for
+-- reconstructing the source text, but also for determining where in
+-- the source text a production was found.
 --
--- The @postal-parser@ executable takes as its first and sole argument
--- a string.  It parses the string using the 'postal' grammar and
--- pretty prints the resultin parses to standard output.
+-- "Pinchot.Examples.RulesToOptics" shows how to generate lenses and
+-- isos, which are valuable for navigating and manipulating large trees.
 --
--- The @parrot@ executable takes as its first and sole argument a
--- string.  It parses the string using the 'postal' grammar.  For
--- every result that is returned (there might be zero, or one, or more
--- than one) the result is reduced to terminal symbols using the
--- 'terminals' function and the result is printed to standard output.
+-- Finally, "Pinchot.Examples.Newman" shows how to actually run the
+-- Earley parsers, find the locations of various productions, and
+-- show the results on-screen.  You can play with
+-- 'Pinchot.Examples.Newman.address' and
+-- 'Pinchot.Examples.Newman.addressFromFile' in GHCi.  Or, if you
+-- compile the Pinchot package using the @executables@ flag, you
+-- will get an executable named @newman@ that you can play with from
+-- the command line.
 
 module Pinchot.Examples where
-
-import Pinchot
-import Pinchot.Examples.Postal
diff --git a/lib/Pinchot/Examples/AllEarleyGrammars.hs b/lib/Pinchot/Examples/AllEarleyGrammars.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/AllEarleyGrammars.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
--- | Provides an example of the use of 'Pinchot.AllEarleyGrammars'.
--- You will want to look at the source code, as it shows what sort
--- of Template Haskell splice to use.
-
-module Pinchot.Examples.AllEarleyGrammars where
-
-import qualified Pinchot
-import qualified Pinchot.Examples.Postal as Postal
-import qualified Pinchot.Examples.PostalAstAllRules as PostalAstAllRules
-
-Pinchot.allEarleyGrammars "PostalAstAllRules" ''Char Postal.postal
diff --git a/lib/Pinchot/Examples/AllRulesRecord.hs b/lib/Pinchot/Examples/AllRulesRecord.hs
--- a/lib/Pinchot/Examples/AllRulesRecord.hs
+++ b/lib/Pinchot/Examples/AllRulesRecord.hs
@@ -1,12 +1,14 @@
--- | Provides an example of the use of 'Pinchot.allRulesRecord'.
--- You will want to look at the source code to see how to write the
--- Template Haskell splice.
-
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This module shows how to generate a product type holding all
+-- the productions that result from a given 'Rule'.  You wil want to
+-- look at the source code, as the Haddocks will show you only the
+-- generated type, not the Template Haskell used to generate it.
 module Pinchot.Examples.AllRulesRecord where
 
-import qualified Pinchot
-import qualified Pinchot.Examples.Postal as Postal
-import qualified Pinchot.Examples.PostalAstAllRules as AllRules
+import Pinchot
+import Pinchot.Examples.Postal
+import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
 
-Pinchot.allRulesRecord "AllRules" ''Char Postal.postal
+$(allRulesRecord "SyntaxTrees" ''Char [rAddress])
diff --git a/lib/Pinchot/Examples/Earley.hs b/lib/Pinchot/Examples/Earley.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Examples/Earley.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This module shows how to generate Earley grammars for your
+-- context-free grammar.  You will want to look at the source code.
+module Pinchot.Examples.Earley where
+
+import Pinchot
+import Pinchot.Examples.Postal
+import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
+import qualified Pinchot.Examples.AllRulesRecord as AllRulesRecord
+import Text.Earley
+
+addressGrammar
+  :: Grammar r (Prod r String (Char, a) (SyntaxTrees.Address Char a))
+addressGrammar = $(earleyGrammarFromRule "SyntaxTrees" rAddress)
+
+addressAllProductions
+  :: Grammar r (AllRulesRecord.Productions r Char a)
+addressAllProductions = $(earleyProduct "SyntaxTrees" "AllRulesRecord"
+  [rAddress])
diff --git a/lib/Pinchot/Examples/EarleyProduct.hs b/lib/Pinchot/Examples/EarleyProduct.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/EarleyProduct.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- | Provides an example of the use of 'Pinchot.earleyProduct'.  You
--- will want to look at the source code, as looking at only the
--- Haddocks will show you only the result of all the Template
--- Haskell splices.
-module Pinchot.Examples.EarleyProduct where
-
-import qualified Pinchot
-
--- You will need to import your Pinchot grammar
-import qualified Pinchot.Examples.Postal as Postal
-
--- And import the types that result from applying
--- 'Pinchot.allRulesToTypes' to the Pinchot grammar
-import qualified Pinchot.Examples.PostalAstAllRules as AllRules
-
--- And, import the product type that results from applying
--- 'Pinchot.allRulesRecord' to your grammar
-import qualified Pinchot.Examples.AllRulesRecord as Record
-
-import qualified Text.Earley as Earley
-
--- | 'Pinchot.earleyProduct' gives you a big product type that has
--- every rule that is in your Pinchot grammar.
-allProductions :: Earley.Grammar r (Record.Productions r)
-allProductions = $(Pinchot.earleyProduct "AllRules" "Record" Postal.postal)
-
--- | To get the exact production you're interested in, just use
--- 'fmap'.  Then you can use this value for 'Earley.parser'.
-addressParser :: Earley.Grammar r (Earley.Prod r String Char AllRules.Address)
-addressParser = fmap Record.a'Address allProductions
diff --git a/lib/Pinchot/Examples/Newman.hs b/lib/Pinchot/Examples/Newman.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Examples/Newman.hs
@@ -0,0 +1,130 @@
+-- | This module provides a simple example of use of everything in
+-- Pinchot.  'address' parses a postal address from a string and
+-- prints a simple report showing some of the elements of the
+-- address and their locations.
+module Pinchot.Examples.Newman where
+
+import Pinchot
+
+import Pinchot.Examples.Earley
+import Pinchot.Examples.SyntaxTrees
+import Pinchot.Examples.Terminalize
+import Pinchot.Examples.RulesToOptics
+
+import qualified Control.Lens as Lens
+import Data.Foldable (toList)
+import Data.List (intersperse)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import qualified Text.Earley as Earley
+
+-- | Formats a 'Loc' for nice on-screen display.
+labelLoc :: Loc -> String
+labelLoc (Loc l c p)
+  = "(line: " ++ show l ++ " col: " ++ show c ++ " pos: "
+  ++ show p ++ ")"
+
+-- | Labels a single field, where the field may or may not appear in
+-- a parsed result.
+labelOpt :: String -> Seq (Char, Loc) -> String
+labelOpt l sq
+  = l ++ ": " ++ show (toList . fmap fst $ sq)
+  ++ " " ++ loc ++ "\n"
+  where
+    loc = case Lens.uncons sq of
+      Nothing -> "(no location)"
+      Just ((_, loc), _) -> labelLoc loc
+
+-- | Labels a single field, where the field will always appear in a
+-- parsed result.
+labelNE :: String -> NonEmpty (Char, Loc) -> String
+labelNE l sq
+  = l ++ ": " ++ show (toList . fmap fst $ sq)
+  ++ " " ++ loc ++ "\n"
+  where
+    loc = labelLoc . snd . _front $ sq
+
+-- | Formats a single 'Address' for nice on-screen display.
+showAddress :: Address Char Loc -> String
+showAddress a = name ++ street ++ city
+  where
+    name = labelNE "Name" . t'Words
+      . _r'NameLine'0'Words . _r'Address'0'NameLine $ a
+    street = number ++ pre ++ streetName ++ suf
+      where
+        number = labelNE "Number" . t'Number . _r'StreetLine'0'Number
+          . _r'Address'1'StreetLine $ a
+
+        pre = labelOpt "Direction prefix"
+          . maybe Seq.empty flatten
+          . Lens.preview (r'Address'1'StreetLine
+                          . r'StreetLine'2'DirectionSpace'Opt
+                          . Lens._Wrapped'
+                          . Lens._Just
+                          . r'DirectionSpace'0'Direction
+                          . Lens.to t'Direction)
+          $ a
+
+        streetName = labelNE "Street"
+          . t'StreetName
+          . _r'StreetLine'3'StreetName
+          . _r'Address'1'StreetLine
+          $ a
+
+        suf = labelOpt "Street suffix"
+          . maybe Seq.empty flatten
+          . Lens.preview (r'Address'1'StreetLine
+                          . r'StreetLine'4'SpaceSuffix'Opt
+                          . Lens._Wrapped'
+                          . Lens._Just
+                          . r'SpaceSuffix'1'Suffix
+                          . Lens.to t'Suffix)
+          $ a
+    city = cty ++ st ++ zip
+      where
+        cty = labelNE "City"
+          . t'City
+          . _r'CityLine'0'City
+          . _r'Address'2'CityLine
+          $ a
+
+        st = labelNE "State"
+          . t'State
+          . _r'CityLine'3'State
+          . _r'Address'2'CityLine
+          $ a
+
+        zip = labelNE "Zip"
+          . t'ZipCode
+          . _r'CityLine'5'ZipCode
+          . _r'Address'2'CityLine
+          $ a
+
+-- | Formats successful 'Address' parses and the 'Earley.Report' for
+-- nice on-screen display.
+showParseResult
+  :: ([Address Char Loc], Earley.Report String (Seq (Char, Loc)))
+  -> String
+showParseResult (addresses, report) = addresses' ++ "\n" ++ report'
+  where
+    addresses' = ("Full parses:\n\n" ++)
+      . concat . intersperse "---\n" . map showAddress
+      $ addresses
+    report' = ("Earley report:\n\n" ++) . show
+      $ report { Earley.unconsumed = toList . fmap fst
+      . Earley.unconsumed $ report }
+
+-- | Parse an address and print the resulting report.  Good for use
+-- in GHCi.
+address :: String -> IO ()
+address = putStrLn . showParseResult . locatedFullParses addressGrammar
+
+-- | Read an address from a file and print the resulting report.
+-- Good for use in GHCi.
+addressFromFile
+  :: String
+  -- ^ Filename
+  -> IO ()
+addressFromFile fn = do
+  str <- readFile fn
+  putStrLn . showParseResult . locatedFullParses addressGrammar $ str
diff --git a/lib/Pinchot/Examples/Postal.hs b/lib/Pinchot/Examples/Postal.hs
--- a/lib/Pinchot/Examples/Postal.hs
+++ b/lib/Pinchot/Examples/Postal.hs
@@ -1,58 +1,105 @@
-{-# LANGUAGE OverloadedStrings, OverloadedLists, RecursiveDo #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-- | This module contains a context-free grammar for U.S. postal
+-- addresses.  It would never hold up to real-world use but it gives
+-- you a good idea of how to write grammars in Pinchot.
+--
+-- The grammar is ambiguous.
+--
+-- There are no signatures; the type of every declaration in the
+-- module is 'Rule' 'Char'.
 module Pinchot.Examples.Postal where
 
 import Pinchot
-
 import Data.Monoid ((<>))
 
--- | A grammar for simple U.S. postal addresses.  This example would never
--- hold up to real-world usage but it gives you a flavor of how
--- Pinchot works.
---
--- The grammar is ambiguous.
-postal :: Pinchot Char (Rule Char)
-postal = mdo
-  digit <- terminal "Digit" (include '0' '9') <?> "digit from 0 to 9"
-  digits <- list1 digit
-  letter <- terminal "Letter" (include 'a' 'z' <> include 'A' 'Z')
-    <?> "letter from A to Z"
-  north <- terminal "North" (solo 'N')
-  south <- terminal "South" (solo 'S')
-  east <- terminal "East" (solo 'E')
-  west <- terminal "West" (solo 'W')
-  direction <- union "Direction" [north, south, east, west]
-  street <- terminalSeq "Street" ['S', 't']
-  avenue <- terminalSeq "Avenue" ['A', 'v', 'e']
-  way <- terminalSeq "Way" ['W', 'a', 'y']
-  boulevard <- terminalSeq "Boulevard" ['B', 'l', 'v', 'd']
-  suffix <- union "Suffix" [street, avenue, way, boulevard]
-  space <- terminal "Space" (solo ' ')
-  comma <- terminal "Comma" (solo ',')
+rDigit = terminal "Digit" (include '0' '9') <?> "digit from 0 to 9"
 
-  -- You could do this with 'list' but this demonstrates how to write
-  -- a recurvsive rule.
-  letters <- nonTerminal "Letters"
-    [ ("NoLetter", [])
-    , ("ConsLetter", [letter, letters])
-    ]
+rDigits = plus rDigit
 
-  -- Named "PostalWord" to avoid clash with Prelude.Word
-  word <- record "PostalWord" [letter, letters]
-  preSpacedWord <- record "PreSpacedWord" [space, word]
-  preSpacedWords <- list preSpacedWord
-  words <- record "Words" [word, preSpacedWords]
+rLetter = terminal "Letter" (include 'a' 'z' <> include 'A' 'Z')
+  <?> "letter from A to Z"
 
-  number <- wrap "Number" digits
-  streetName <- wrap "StreetName" words
-  city <- wrap "City" words
-  state <- wrap "State" word
-  zipCode <- wrap "ZipCode" digits
-  directionSpace <- record "DirectionSpace" [direction, space]
-  spaceSuffix <- record "SpaceSuffix" [space, suffix]
-  optDirection <- option directionSpace
-  optSuffix <- option spaceSuffix
-  address <- record "Address"
-    [ number, space, optDirection, streetName, optSuffix,
-      comma, space, city, comma, space, state, space, zipCode
-    ]
-  return address
+rNorth = terminal "North" (solo 'N')
+
+rSouth = terminal "South" (solo 'S')
+
+rEast = terminal "East" (solo 'E')
+
+rWest = terminal "West" (solo 'W')
+
+rNE = terminals "NE" "NE"
+
+rNW = terminals "NW" "NW"
+
+rSW = terminals "SW" "SW"
+
+rSE = terminals "SE" "SE"
+
+rDirection = union "Direction"
+  [rNorth, rSouth, rEast, rWest, rNE, rNW, rSE, rSW]
+
+rStreet = terminals "Street" "St"
+
+rAvenue = terminals "Avenue" "Ave"
+
+rWay = terminals "Way" "Way"
+
+rBoulevard = terminals "Boulevard" "Blvd"
+
+rSuffix = union "Suffix" [rStreet, rAvenue, rWay, rBoulevard]
+
+rSpace = terminal "Space" (solo ' ')
+
+rComma = terminal "Comma" (solo ',')
+
+rNewline = terminal "Newline" (solo '\n')
+
+rCommaSpace = record "CommaSpace" [rComma, rSpace]
+
+rSeparator = union "Separator" [rCommaSpace, rNewline]
+
+rLetters = nonTerminal "Letters"
+  [ ("NoLetter", [])
+  , ("ConsLetter", [rLetter, rLetters])
+  ]
+
+-- Named "PostalWord" to avoid clash with Prelude.Word
+rPostalWord = record "PostalWord" [rLetter, rLetters]
+
+rPreSpacedWord = record "PreSpacedWord" [rSpace, rPostalWord]
+
+rPreSpacedWords = star rPreSpacedWord
+
+rWords = record "Words" [rPostalWord, rPreSpacedWords]
+
+rNumber = wrap "Number" rDigits
+
+rStreetName = wrap "StreetName" rWords
+
+rCity = wrap "City" rWords
+
+rState = wrap "State" rWords
+
+rZipCode = record "ZipCode" [rDigit, rDigit, rDigit, rDigit, rDigit]
+
+rDirectionSpace = record "DirectionSpace" [rDirection, rSpace]
+
+rSpaceSuffix = record "SpaceSuffix" [rSpace, rSuffix]
+
+rOptDirection = opt rDirectionSpace
+
+rOptSuffix = opt rSpaceSuffix
+
+rOptNewline = opt rNewline
+
+rNameLine = record "NameLine" [rWords, rSeparator]
+
+rStreetLine = record "StreetLine" [rNumber, rSpace, rOptDirection,
+  rStreetName, rOptSuffix, rSeparator]
+
+rCityLine = record "CityLine" [rCity, rComma, rSpace, rState,
+  rSpace, rZipCode, rOptNewline]
+
+rAddress = record "Address" [rNameLine, rStreetLine, rCityLine]
diff --git a/lib/Pinchot/Examples/PostalAstAllRules.hs b/lib/Pinchot/Examples/PostalAstAllRules.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/PostalAstAllRules.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverloadedLists #-}
-
--- | Provides an example of the use of 'ruleTreeToTypes'.  You will
--- want to look at the source code, as it has a Template Haskell
--- splice that produces all of the data types that you see in the
--- Haddocks.
-module Pinchot.Examples.PostalAstAllRules where
-
-import Pinchot
-import Pinchot.Examples.Postal
-
--- Earley is imported only for the type signature for 'postalGrammar'.  The
--- Template Haskell does not need the import.
-import Text.Earley (Grammar, Prod)
-
--- This Template Haskell splice will produce a list of declarations,
--- with one declaration for each production rule in the grammar.
--- Unlike 'ruleTreeToTypes', this splice will contain every rule that
--- was defined in the 'Pinchot'.
-allRulesToTypes makeOptics ''Char [''Eq, ''Ord, ''Show] postal
-
--- | Earley grammar created using Template Haskell.
-
-postalGrammar :: Grammar r (Prod r String Char Address)
-postalGrammar = $(earleyGrammar "" postal)
diff --git a/lib/Pinchot/Examples/PostalAstNoLenses.hs b/lib/Pinchot/Examples/PostalAstNoLenses.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/PostalAstNoLenses.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedLists #-}
--- | Provides an example of 'ruleTreeToTypes', but unlike
--- "Pinchot.Examples.PostalAstAllRules", does not make optics.
-
-module Pinchot.Examples.PostalAstNoLenses where
-
-import Pinchot
-import Pinchot.Examples.Postal
-
--- Earley is imported only for the type signature for 'myParser'.  The
--- Template Haskell does not need the import.
-import Text.Earley (Grammar, Prod)
-
--- This Template Haskell splice will produce a list of declarations,
--- with one declaration for each production rule in the grammar.
--- Unlike 'ruleTreeToTypes', this splice will contain every rule that
--- was defined in the 'Pinchot'.
-allRulesToTypes noOptics ''Char [''Eq, ''Ord, ''Show] postal
-
--- | Earley grammar created using Template Haskell.
-
-postalGrammar :: Grammar r (Prod r String Char Address)
-postalGrammar = $(earleyGrammar "" postal)
diff --git a/lib/Pinchot/Examples/PostalAstRuleTree.hs b/lib/Pinchot/Examples/PostalAstRuleTree.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/PostalAstRuleTree.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverloadedLists #-}
-
--- | Provides an example of the use of 'ruleTreeToTypes'.  You will
--- want to look at the source code, as it has a Template Haskell
--- splice that produces all of the data types that you see in the
--- Haddocks.
-module Pinchot.Examples.PostalAstRuleTree where
-
-import Pinchot
-import Pinchot.Examples.Postal
-
--- Earley is imported only for the type signature for 'myParser'.  The
--- Template Haskell does not need the import.
-import Text.Earley (Grammar, Prod)
-
--- This Template Haskell splice will produce a list of declarations,
--- with one declaration for each production rule in the grammar.
--- Unlike 'allRulesToTypes', this splice will contain only the
--- 'Address' rule and its ancestors.
-
-ruleTreeToTypes makeOptics ''Char [''Eq, ''Ord, ''Show] postal
-
--- | Earley grammar created using Template Haskell.
-
-postalGrammar :: Grammar r (Prod r String Char Address)
-postalGrammar = $(earleyGrammar "" postal)
diff --git a/lib/Pinchot/Examples/QualifiedImport.hs b/lib/Pinchot/Examples/QualifiedImport.hs
deleted file mode 100644
--- a/lib/Pinchot/Examples/QualifiedImport.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- | Provides an example of the use of 'earleyParser' with a qualified
--- import of the data types that comprise the grammar.
-
-module Pinchot.Examples.QualifiedImport where
-
-import Pinchot
-import qualified Pinchot.Examples.PostalAstRuleTree as Ast
-import qualified Pinchot.Examples.Postal as Postal
-
--- Earley is imported only for the type signature for 'myParser'.  The
--- Template Haskell does not need the import.
-import Text.Earley (Grammar, Prod)
-
--- | Earley parser created using Template Haskell.
-
-myParser :: Grammar r (Prod r String Char Ast.Address)
-myParser = $(earleyGrammar "Ast" Postal.postal)
diff --git a/lib/Pinchot/Examples/RulesToOptics.hs b/lib/Pinchot/Examples/RulesToOptics.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Examples/RulesToOptics.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This module shows how to use Template Haskell to generate
+-- optics (lenses, prisms, and isos) for the rules in your grammar.
+-- You will want to look at the source code, as the Haddocks will
+-- show the generated types but it will not show the Template
+-- Haskell used to generate them.
+module Pinchot.Examples.RulesToOptics where
+
+import Pinchot
+import Pinchot.Examples.Postal
+import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
+
+$(rulesToOptics "SyntaxTrees" ''Char [rAddress])
diff --git a/lib/Pinchot/Examples/SyntaxTrees.hs b/lib/Pinchot/Examples/SyntaxTrees.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Examples/SyntaxTrees.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+
+-- The following extension is required only for the splice of Lens wrapped
+-- instances in 'wrappedInstances'
+{-# LANGUAGE TypeFamilies #-}
+
+-- | This module shows how to use Template Haskell to generate the
+-- data types corresponding to your context-free grammar.  You will
+-- want to look at the source; the Haddocks will show only the
+-- generated types and not the Template Haskell that was used to
+-- generate them.
+module Pinchot.Examples.SyntaxTrees where
+
+import Pinchot
+import Pinchot.SyntaxTree.Wrappers
+import Pinchot.Examples.Postal
+
+import qualified Control.Lens as Lens
+
+-- This generates the data types corresponding to the 'rAddress'
+-- 'Rule', as well as all the ancestors of that 'Rule'.
+$(syntaxTrees ''Char
+  [''Eq, ''Ord, ''Show, ''Foldable, ''Traversable, ''Functor]
+  [rAddress])
+
+-- This generates intances of the Lens Wrapped typeclass.
+$(wrappedInstances [rAddress])
diff --git a/lib/Pinchot/Examples/Terminalize.hs b/lib/Pinchot/Examples/Terminalize.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Examples/Terminalize.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This module shows how to use Template Haskell to generate
+-- functions that will reduce any production to the terminal tokens
+-- that were used to create it.
+module Pinchot.Examples.Terminalize where
+
+import Pinchot
+import Pinchot.Examples.Postal
+import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
+
+terminalizeAddress :: SyntaxTrees.Address t a -> NonEmpty (t, a)
+terminalizeAddress = $(terminalizeRuleExp "SyntaxTrees" rAddress)
+
+$(terminalizers "SyntaxTrees" ''Char [rAddress])
diff --git a/lib/Pinchot/Internal.hs b/lib/Pinchot/Internal.hs
deleted file mode 100644
--- a/lib/Pinchot/Internal.hs
+++ /dev/null
@@ -1,1535 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
--- | Pinchot internals.  Ordinarily the "Pinchot" module should have
--- everything you need.
-
-module Pinchot.Internal where
-
-import Pinchot.Intervals
-
-import Control.Applicative ((<|>), liftA2)
-import Control.Exception (Exception)
-import qualified Control.Lens as Lens
-import Control.Monad (join, when)
-import Control.Monad.Fix (MonadFix, mfix)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
-import Control.Monad.Trans.State (State, runState, get, put)
-import Data.Char (isUpper)
-import Data.Foldable (toList)
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Monoid ((<>))
-import Data.Set (Set)
-import Data.Sequence (Seq, ViewL(EmptyL, (:<)), viewl, (<|))
-import qualified Data.Sequence as Seq
-import qualified Data.Set as Set
-import Data.Typeable (Typeable)
-import Language.Haskell.TH
-  (ExpQ, ConQ, normalC, mkName, strictType, notStrict, newtypeD,
-   cxt, conT, Name, dataD, appT, DecsQ, appE, Q, uInfixE,
-   varE, varP, conE, Pat, Exp, recC, varStrictType, dyn)
-import qualified Language.Haskell.TH as TH
-import qualified Language.Haskell.TH.Syntax as Syntax
-import Text.Earley (satisfy, rule, symbol)
-import qualified Text.Earley
-
--- | Type synonym for the name of a production rule.  This will be the
--- name of the type constructor for the corresponding type that will
--- be created, so this must be a valid Haskell type constructor name.
---
--- If you are creating a 'terminal', 'option', 'list', 'list1', or
--- 'wrap', the 'RuleName' will also be used for the name of the single
--- data construtor.  If you are creating a 'nonTerminal', you will
--- specify the name of each data constructor with 'AlternativeName'.
-type RuleName = String
-
--- | Type synonym the the name of an alternative in a 'nonTerminal'.
--- This name must not conflict with any other data constructor, either
--- one specified as an 'AlternativeName' or one that was created using
--- 'terminal', 'option', 'list', or 'list1'.
-type AlternativeName = String
-
--- | A branch in a sum rule.  In @Branch s ls@, @s@ is the name of the
--- data constructor, and @ls@ is the list of rules that this branch
--- produces.
-data Branch t = Branch String (Seq (Rule t))
-  deriving (Eq, Ord, Show)
-
-data RuleType t
-  = RTerminal (Intervals t)
-  | RBranch (Branch t, Seq (Branch t))
-  | RUnion (Rule t, Seq (Rule t))
-  | RSeqTerm (Seq t)
-  | ROptional (Rule t)
-  | RList (Rule t)
-  | RList1 (Rule t)
-  | RWrap (Rule t)
-  | RRecord (Seq (Rule t))
-  deriving (Eq, Ord, Show)
-
--- Rule n d t, where
---
--- n is the name of the rule.  This is used as the name of the
--- corresponding data type.
---
--- d is the description of the rule.  This is optional and is used for
--- the parser's error messages.  If there is no description, the name
--- is used for error messages.
---
--- t is the type of rule (terminal, branch, etc.)
-
--- | A single production rule.  It may be a terminal or a non-terminal.
-data Rule t = Rule String (Maybe String) (RuleType t)
-  deriving (Eq, Ord, Show)
-
--- | Name a 'Rule' for use in error messages.  If you do not name a
--- rule using this combinator, the rule's type name will be used in
--- error messages.
-label :: String -> Rule t -> Rule t
-label s (Rule n _ t) = Rule n (Just s) t
-
--- | Infix form of 'label' for use in a 'Pinchot'; handy for use in
--- @do@ or @mdo@ notation.
-(<?>) :: Pinchot t (Rule t) -> String -> Pinchot t (Rule t)
-p <?> s = fmap (label s) p
-infixr 0 <?>
-
-data Names t = Names
-  { tyConNames :: Set RuleName
-  , dataConNames :: Set String
-  , nextIndex :: Int
-  , allRules :: Map Int (Rule t)
-  } deriving (Eq, Ord, Show)
-
--- | Errors that may arise when constructing an AST.
-data Error
-  = InvalidName String
-  -- ^ A name was invalid.  The field is the invalid name.  The name
-  -- might be invalid because it was already used, or because it does
-  -- not begin with a capital letter.
-  | EmptyNonTerminal String
-  -- ^ A non-terminal must have at least one summand.  The field is
-  -- the name of the empty non-terminal.
-  deriving (Show, Typeable)
-
-instance Exception Error
-
--- | Constructs new 'Rule's.  @t@ is the type of the token; often this
--- will be 'Char'.
---
--- 'Pinchot' is a 'Monad' and an 'Applicative' so you can combine
--- computations using the usual methods of those classes.  Also,
--- 'Pinchot' is a 'MonadFix'.  This allows you to construct a 'Rule'
--- that depends on itself, and to construct sets of 'Rule's that have
--- mutually recursive dependencies.  'MonadFix' also allows you to use
--- the GHC @RecursiveDo@ extension.  Put
---
--- @
--- {-\# LANGUAGE RecursiveDo \#-}
--- @
---
--- at the top of your module, then use @mdo@ instead of @do@.  Because
--- an @mdo@ block is recursive, you can use a binding before it is
--- defined, just as you can in a set of @let@ bindings.
-
-newtype Pinchot t a
-  = Pinchot { runPinchot :: ExceptT Error (State (Names t)) a }
-  deriving (Functor, Applicative, Monad, MonadFix)
-
--- | Runs a 'Pinchot' with a starting empty state.  Fails in the Q
--- monad if the grammar is bad.
-goPinchot :: Pinchot t a -> Q (Names t, a)
-goPinchot (Pinchot pinc) = case fst pair of
-  Left err -> fail $ "pinchot: bad grammar: " ++ show err
-  Right g -> return (snd pair, g)
-  where
-    pair = runState (runExceptT pinc)
-      (Names Set.empty Set.empty 0 M.empty)
-
-addRuleName
-  :: RuleName
-  -> Pinchot t ()
-addRuleName name = Pinchot $ do
-  old@(Names tyNames _ _ _) <- lift get
-  case name of
-    [] -> throw
-    x:_ -> do
-      when (not (isUpper x)) throw
-      when (Set.member name tyNames) throw
-      lift $ put (old { tyConNames = Set.insert name tyNames })
-  where
-    throw = throwE $ InvalidName name
-
-addDataConName
-  :: AlternativeName
-  -> Pinchot t ()
-addDataConName name = Pinchot $ do
-  old@(Names _ dcNames _ _) <- lift get
-  case name of
-    [] -> throw
-    x:_ -> do
-      when (not (isUpper x)) throw
-      when (Set.member name dcNames) throw
-      lift $ put (old { dataConNames = Set.insert name dcNames })
-  where
-    throw = throwE $ InvalidName name
-
-newRule
-  :: RuleName
-  -> RuleType t
-  -> Pinchot t (Rule t)
-newRule name ty = Pinchot $ do
-  runPinchot (addRuleName name)
-  st <- lift get
-  let r = Rule name Nothing ty
-      newSt = st { nextIndex = succ (nextIndex st)
-                 , allRules = M.insert (nextIndex st) r
-                            (allRules st)
-                 }
-  lift (put newSt)
-  runPinchot $ addDataConNames r
-  return r
-
--- | Creates a terminal production rule.
-terminal
-
-  :: RuleName
-
-  -> Intervals t
-  -- ^ Valid terminal symbols
-
-  -> Pinchot t (Rule t)
-
-terminal name ivls = newRule name (RTerminal ivls)
-
-splitNonTerminal
-  :: String
-  -> Seq (String, Seq (Rule t))
-  -> Pinchot t ((String, Seq (Rule t)), Seq (String, Seq (Rule t)))
-splitNonTerminal n sq = Pinchot $ case viewl sq of
-  EmptyL -> throwE $ EmptyNonTerminal n
-  x :< xs -> return (x, xs)
-
--- | Creates a production for a sequence of terminals.  Useful for
--- parsing specific words.
-terminalSeq
-
-  :: RuleName
-
-  -> Seq t
-  -- ^ Sequence of terminal symbols to recognize
-
-  -> Pinchot t (Rule t)
-
-terminalSeq name sq = newRule name (RSeqTerm sq)
-
--- | Creates a new non-terminal production rule.
-nonTerminal
-
-  :: RuleName
-
-  -> Seq (AlternativeName, Seq (Rule t))
-  -- ^ Alternatives.  There must be at least one alternative;
-  -- otherwise, an error will result.  In each pair @(a, b)@, @a@ will
-  -- be the data constructor, so this must be a valid Haskell data
-  -- constructor name.  @b@ is the sequence of production rules, which
-  -- can be empty (this is how to create an epsilon production).
-
-  -> Pinchot t (Rule t)
-
-nonTerminal name sq = do
-  (b1, bs) <- splitNonTerminal name sq
-  let branches = RBranch (uncurry Branch b1, fmap (uncurry Branch) bs)
-  newRule name branches
-
-ruleConstructorNames
-  :: Rule t
-  -> Seq AlternativeName
-ruleConstructorNames (Rule n _ t) = case t of
-  RTerminal _ -> Seq.singleton n
-  RBranch (b1, bs) -> branchName b1 <| fmap branchName bs
-    where
-      branchName (Branch x _) = x
-  RUnion (b1, bs) -> branchName b1 <| fmap branchName bs
-    where
-      branchName (Rule x _ _) = unionBranchName n x
-  RSeqTerm _ -> Seq.singleton n
-  ROptional _ -> Seq.singleton n
-  RList _ -> Seq.singleton n
-  RList1 _ -> Seq.singleton n
-  RWrap _ -> Seq.singleton n
-  RRecord _ -> Seq.singleton n
-
-unionBranchName
-  :: RuleName
-  -- ^ Name of the parent rule
-  -> RuleName
-  -- ^ Name of the branch rule
-  -> AlternativeName
-unionBranchName p b = p ++ '\'' : b
-
-addDataConNames :: Rule t -> Pinchot t ()
-addDataConNames = mapM_ addDataConName . ruleConstructorNames
-
--- | Creates a new non-terminal production rule where each alternative
--- produces only one rule.  The constructor name for each alternative
--- is
---
--- @RULE_NAME'PRODUCTION_NAME@
---
--- where @RULE_NAME@ is the name of the rule itself, and
--- @PRODUCTION_NAME@ is the rule name for what is being produced.  For
--- an example, see 'Pinchot.Examples.PostalAstAllRules.Suffix'.
---
--- Currently there is no way to change the names of the constructors;
--- however, you can use 'nonTerminal', which is more flexible.
-union
-  :: RuleName
-  -> Seq (Rule t)
-  -- ^ List of alternatives.  There must be at least one alternative;
-  -- otherwise a compile-time error will occur.
-  -> Pinchot t (Rule t)
-union name sq = Pinchot $ case viewl sq of
-  EmptyL -> throwE $ EmptyNonTerminal name
-  x :< xs -> runPinchot $ newRule name (RUnion (x, xs))
-
--- | Creates a new non-terminal production rule with only one
--- alternative where each field has a record name.  The name of each
--- record is:
---
--- @_r\'RULE_NAME\'INDEX\'FIELD_TYPE@
---
--- where @RULE_NAME@ is the name of this rule, @INDEX@ is the index number
--- for this field (starting with 0), and @FIELD_TYPE@ is the type of the
--- field itself.  For an example, see
--- 'Pinchot.Examples.PostalAstAllRules.Address'.
---
--- Currently there is no way to change the names of the record fields.
-record
-  :: RuleName
-  -- ^ The name of this rule, which is used both as the type name and
-  -- the name of the sole data constructor.
-  -> Seq (Rule t)
-  -- ^ The right-hand side of this rule.  This sequence can be empty,
-  -- which results in an epsilon production.
-  -> Pinchot t (Rule t)
-record name sq = newRule name (RRecord sq)
-
-
--- | Creates a rule for the production of a sequence of other rules.
--- The name for the created 'Rule' is the name of the 'Rule' to which
--- this function is applied, with @'Seq@ appended.
-list
-  :: Rule t
-  -- ^ The resulting 'Rule' is a sequence of productions of this
-  -- 'Rule'; that is, this 'Rule' may appear zero or more times.
-
-  -> Pinchot t (Rule t)
-list r@(Rule inner _ _) = newRule name (RList r)
-  where
-    name = inner ++ "'Seq"
-
--- | Creates a rule for a production that appears at least once.  The
--- name for the created 'Rule' is the name of the 'Rule' to which this
--- function is applied, with @'Seq1@ appended.
-list1
-  :: Rule t
-  -- ^ The resulting 'Rule' produces this 'Rule' at least once.
-  -> Pinchot t (Rule t)
-list1 r@(Rule inner _ _) = newRule name (RList1 r)
-  where
-    name = inner ++ "'Seq1"
-
--- | Creates a rule for a production that optionally produces another
--- rule.  The name for the created 'Rule' is the name of the 'Rule' to
--- which this function is applied, with @'Maybe@ appended to the end.
-option
-  :: Rule t
-  -- ^ The resulting 'Rule' optionally produces this 'Rule'; that is,
-  -- this 'Rule' may appear once or not at all.
-
-  -> Pinchot t (Rule t)
-option r@(Rule inner _ _) = newRule name (ROptional r)
-  where
-    name = inner ++ "'Maybe"
-
--- | Creates a newtype wrapper.
-
-wrap
-  :: RuleName
-  -> Rule t
-  -- ^ The resulting 'Rule' simply wraps this 'Rule'.
-  -> Pinchot t (Rule t)
-wrap name r = newRule name (RWrap r)
-
--- | Gets all ancestor 'Rule's.  Skips duplicates.
-getAncestors
-  :: Rule t
-  -> State (Set String) (Seq (Rule t))
-getAncestors r@(Rule name _ ei) = do
-  set <- get
-  if Set.member name set
-    then return Seq.empty
-    else do
-      put (Set.insert name set)
-      case ei of
-        RTerminal _ -> return (Seq.singleton r)
-        RBranch (b1, bs) -> do
-          as1 <- branchAncestors b1
-          ass <- fmap join . mapM branchAncestors $ bs
-          return $ r <| as1 <> ass
-        RUnion (b1, bs) -> do
-          c1 <- getAncestors b1
-          cs <- fmap join . mapM getAncestors $ bs
-          return $ r <| c1 <> cs
-        RSeqTerm _ -> return (Seq.singleton r)
-        ROptional c -> do
-          cs <- getAncestors c
-          return $ r <| cs
-        RList c -> do
-          cs <- getAncestors c
-          return $ r <| cs
-        RList1 c -> do
-          cs <- getAncestors c
-          return $ r <| cs
-        RWrap c -> do
-          cs <- getAncestors c
-          return $ r <| cs
-        RRecord ls -> do
-          cs <- fmap join . mapM getAncestors $ ls
-          return $ r <| cs
-  where
-    branchAncestors (Branch _ rs) = fmap join . mapM getAncestors $ rs
-
--- | Returns both this 'Rule' and any 'Rule's that are ancestors.
-ruleAndAncestors
-  :: Rule t
-  -> Seq (Rule t)
-ruleAndAncestors r = fst $ runState (getAncestors r) Set.empty
-
--- | Given a sequence of 'Rule', determine which rules are on a
--- right-hand side before they are defined.
-rulesDemandedBeforeDefined :: Foldable f => f (Rule t) -> Set Name
-rulesDemandedBeforeDefined = snd . foldl f (Set.empty, Set.empty)
-  where
-    f (lhsDefined, results) (Rule nm _ ty)
-      = (Set.insert nm lhsDefined, results')
-      where
-        results' = case ty of
-          RTerminal _ -> results
-          RBranch (b1, bs) -> foldr checkBranch (checkBranch b1 results) bs
-            where
-              checkBranch (Branch _ rls) rslts = foldr checkRule rslts rls
-          RUnion (b1, bs) -> foldr checkRule (checkRule b1 results) bs
-          RSeqTerm _ -> results
-          ROptional r -> checkRule r results
-          RList r -> addHelper $ checkRule r results
-          RList1 r -> addHelper $ checkRule r results
-          RWrap r -> checkRule r results
-          RRecord sq -> foldr checkRule results $ sq
-        checkRule (Rule name _ _) rslts
-          | Set.member name lhsDefined = rslts
-          | otherwise = Set.insert (ruleName name) rslts
-        addHelper = Set.insert (helperName nm)
-  
-
-thBranch :: Branch t -> ConQ
-thBranch (Branch nm rules) = normalC name fields
-  where
-    name = mkName nm
-    mkField (Rule n _ _) = strictType notStrict (conT (mkName n))
-    fields = toList . fmap mkField $ rules
-
-thUnionBranch
-  :: RuleName
-  -- ^ Parent rule name
-  -> Rule t
-  -- ^ Child rule
-  -> ConQ
-thUnionBranch parent (Rule child _ _) = normalC name fields
-  where
-    name = mkName (unionBranchName parent child)
-    fields = [strictType notStrict (conT (mkName child))]
-
-thRule
-  :: Syntax.Lift t
-  => Bool
-  -- ^ If True, make lenses.
-  -> Name
-  -- ^ Name of terminal type
-  -> Seq Name
-  -- ^ What to derive
-  -> Rule t
-  -> TH.Q [TH.Dec]
-thRule doLenses typeName derives (Rule nm _ ruleType) = do
-  ty <- makeType typeName derives nm ruleType
-  lenses <- if doLenses then ruleToOptics typeName nm ruleType
-    else return []
-  inst <- productionDecl nm typeName ruleType
-  return (ty : inst ++ lenses)
-
-
-makeType
-  :: Name
-  -- ^ Name of terminal type
-  -> Seq Name
-  -- ^ What to derive
-  -> String
-  -- ^ Name of rule
-  -> RuleType t
-  -> TH.Q TH.Dec
-makeType typeName derivesSeq nm ruleType = case ruleType of
-  RTerminal _ -> newtypeD (cxt []) name [] newtypeCon derives
-    where
-      newtypeCon = normalC name
-        [strictType notStrict (conT typeName)]
-
-  RBranch (b1, bs) -> dataD (cxt []) name [] cons derives
-    where
-      cons = thBranch b1 : toList (fmap thBranch bs)
-
-  RUnion (b1, bs) -> dataD (cxt []) name [] cons derives
-    where
-      cons = thUnionBranch nm b1 : toList (fmap (thUnionBranch nm) bs)
-
-  RSeqTerm _ -> newtypeD (cxt []) name [] cons derives
-    where
-      cons = normalC name
-        [strictType notStrict (appT [t| Seq |]
-                                    (conT typeName))]
-
-  ROptional (Rule inner _ _) -> newtypeD (cxt []) name [] newtypeCon derives
-    where
-      newtypeCon = normalC name
-        [strictType notStrict (appT [t| Maybe |]
-                                    (conT (mkName inner)))]
-
-  RList (Rule inner _ _) -> newtypeD (cxt []) name [] newtypeCon derives
-    where
-      newtypeCon = normalC name
-        [strictType notStrict (appT [t| Seq |]
-                                    (conT (mkName inner)))]
-
-  RList1 (Rule inner _ _) -> newtypeD (cxt []) name [] cons derives
-    where
-      cons = normalC name
-        [ strictType notStrict (TH.tupleT 2 `appT` (conT (mkName inner))
-            `appT` ([t| Seq |] `appT` (conT (mkName inner)))) ]
-
-  RWrap (Rule inner _ _) -> newtypeD (cxt []) name [] newtypeCon derives
-    where
-      newtypeCon = normalC name
-        [ strictType notStrict (conT (mkName inner)) ]
-
-  RRecord sq -> dataD (cxt []) name [] [ctor] derives
-    where
-      ctor = recC name . zipWith mkField [(0 :: Int) ..] . toList $ sq
-      mkField num (Rule rn _ _) = varStrictType (mkName fldNm)
-        (strictType notStrict (conT (mkName rn)))
-        where
-          fldNm = '_' : fieldName num nm rn
-
-  where
-    name = mkName nm
-    derives = toList derivesSeq
-
--- | Field name - without a leading underscore
-fieldName
-  :: Int
-  -- ^ Index
-  -> String
-  -- ^ Parent type name
-  -> String
-  -- ^ Inner type name
-  -> String
-fieldName idx par inn = "r'" ++ par ++ "'" ++ show idx ++ "'" ++ inn
-
-thAllRules
-  :: Syntax.Lift t
-  => Bool
-  -- ^ If True, make optics as well.
-  -> Name
-  -- ^ Terminal type constructor name
-  -> Seq Name
-  -- ^ What to derive
-  -> Map Int (Rule t)
-  -> DecsQ
-thAllRules doOptics typeName derives
-  = fmap join
-  . sequence
-  . fmap (thRule doOptics typeName derives)
-  . fmap snd
-  . M.toAscList
-
-makeWrapped
-  :: TH.Type
-  -- ^ Name of wrapped type
-  -> String
-  -- ^ Name of wrapper type
-  -> TH.Dec
-makeWrapped wrappedType nm = TH.InstanceD [] typ decs
-  where
-    name = TH.mkName nm
-    local = mkName "_x"
-    typ = (TH.ConT ''Lens.Wrapped) `TH.AppT` (TH.ConT name)
-    decs = [assocType, wrapper]
-      where
-        assocType = TH.TySynInstD ''Lens.Unwrapped
-          (TH.TySynEqn [TH.ConT name] wrappedType)
-        wrapper = TH.FunD 'Lens._Wrapped
-          [TH.Clause [] (TH.NormalB body) []]
-          where
-            body = (TH.VarE 'Lens.iso)
-              `TH.AppE` unwrap
-              `TH.AppE` doWrap
-              where
-                unwrap = TH.LamE [lambPat] (TH.VarE local)
-                  where
-                    lambPat = TH.ConP name [TH.VarP local]
-                doWrap = TH.LamE [lambPat] expn
-                  where
-                    expn = (TH.ConE name)
-                      `TH.AppE` (TH.VarE local)
-                    lambPat = TH.VarP local
-
--- | TH helper like 'dyn' but for patterns
-dynP :: String -> TH.PatQ
-dynP = TH.varP . TH.mkName
-
-seqTermToOptics
-  :: Syntax.Lift t
-  => Name
-  -- ^ Terminal type name
-  -> String
-  -- ^ Rule name
-  -> Seq t
-  -> TH.Q [TH.Dec]
-seqTermToOptics termName nm sq = do
-  e1 <- TH.sigD (TH.mkName ('_':nm)) (TH.conT ''Lens.Prism'
-    `TH.appT` (TH.conT ''Seq `TH.appT` TH.conT termName)
-    `TH.appT` TH.conT (TH.mkName nm))
-  e2 <- TH.valD prismName (TH.normalB expn) []
-  return [e1, e2]
-  where
-    prismName = TH.varP (TH.mkName ('_' : nm))
-    fetchPat = TH.conP (TH.mkName nm) [TH.varP (TH.mkName "_x")]
-    fetchName = TH.varE (TH.mkName "_x")
-    ctor = TH.conE (TH.mkName nm)
-    expn = [| let fetch $fetchPat = $fetchName
-                  store _term
-                    | $(liftSeq sq) == _term = Right ($ctor _term)
-                    | otherwise = Left _term
-              in Lens.prism fetch store
-           |]
-
--- | Creates a prism for a terminal type.  Although a newtype wraps
--- each terminal, do not make a Wrapped or an Iso, because the
--- relationship between the outer type and the type that it wraps
--- typically is not isometric.  Thus, use a Prism instead, which
--- captures this relationship properly.
-terminalToOptics
-  :: Syntax.Lift t
-  => Name
-  -- ^ Terminal type name
-  -> String
-  -- ^ Rule name
-  -> Intervals t
-  -> TH.Q [TH.Dec]
-terminalToOptics termName nm ivls = do
-  e1 <- TH.sigD (TH.mkName ('_':nm)) (TH.conT ''Lens.Prism'
-        `TH.appT` TH.conT termName
-        `TH.appT` TH.conT (TH.mkName nm))
-  e2 <- TH.valD prismName (TH.normalB expn) []
-  return [e1, e2]
-  where
-    prismName = TH.varP (TH.mkName ('_' : nm))
-    fetchPat = TH.conP (TH.mkName nm) [TH.varP (TH.mkName "_x")]
-    fetchName = TH.varE (TH.mkName "_x")
-    ctor = TH.conE (TH.mkName nm)
-    expn = [| let fetch $fetchPat = $fetchName
-                  store _term
-                    | inIntervals ivls _term = Right ($ctor _term)
-                    | otherwise = Left _term
-              in Lens.prism fetch store
-           |]
-    
-
-optionalToOptics
-  :: String
-  -- ^ Wrapped rule name
-  -> String
-  -- ^ Wrapping Rule name
-  -> TH.Dec
-optionalToOptics wrappedName = makeWrapped maybeName
-  where
-    maybeName = (TH.ConT ''Maybe) `TH.AppT` (TH.ConT (TH.mkName wrappedName))
-
-many1ToOptics
-  :: String
-  -- ^ Wrapped rule name
-  -> String
-  -- ^ Wrapping Rule name
-  -> TH.Dec
-many1ToOptics wrappedName = makeWrapped tupName
-  where
-    tupName = (TH.TupleT 2)
-      `TH.AppT` (TH.ConT (TH.mkName wrappedName))
-      `TH.AppT` ((TH.ConT ''Seq) `TH.AppT` (TH.ConT (TH.mkName wrappedName)))
-
-manyToOptics
-  :: String
-  -- ^ Wrapped rule name
-  -> String
-  -- ^ Wrapping Rule name
-  -> TH.Dec
-manyToOptics wrappedName = makeWrapped innerName
-  where
-    innerName = (TH.ConT ''Seq) `TH.AppT` (TH.ConT (TH.mkName wrappedName))
-
-wrapToOptics
-  :: String
-  -- ^ Wrapped rule name
-  -> String
-  -- ^ Wrapping Rule name
-  -> TH.Dec
-wrapToOptics wrappedName = makeWrapped innerName
-  where
-    innerName = TH.ConT (TH.mkName wrappedName)
-
-terminalSeqToOptics
-  :: Name
-  -- ^ Terminal type name
-  -> String
-  -- ^ Rule name
-  -> TH.Dec
-terminalSeqToOptics terminalName = makeWrapped sqType
-  where
-    sqType = (TH.ConT ''Seq) `TH.AppT` (TH.ConT terminalName)
-
-branchesToOptics
-  :: String
-  -- ^ Rule name
-  -> Branch t
-  -> Seq (Branch t)
-  -> [TH.Dec]
-branchesToOptics nm b1 bsSeq = concat $ makePrism b1 : fmap makePrism bs
-  where
-    bs = toList bsSeq
-    makePrism (Branch inner rulesSeq) = [ signature, binding ]
-      where
-        rules = toList rulesSeq
-        prismName = TH.mkName ('_' : inner)
-        signature = TH.SigD prismName
-          $ (TH.ConT ''Lens.Prism')
-          `TH.AppT` (TH.ConT (TH.mkName nm))
-          `TH.AppT` fieldsType
-          where
-            fieldsType = case rules of
-              [] -> TH.TupleT 0
-              Rule r1 _ _ : [] -> TH.ConT (TH.mkName r1)
-              rs -> foldl addType (TH.TupleT (length rs)) rs
-                where
-                  addType soFar (Rule r _ _) = soFar `TH.AppT`
-                    (TH.ConT (TH.mkName r))
-        binding = TH.ValD (TH.VarP prismName) body []
-          where
-            body = TH.NormalB
-              $ (TH.VarE 'Lens.prism)
-              `TH.AppE` setter
-              `TH.AppE` getter
-              where
-                setter = TH.LamE [pat] expn
-                  where
-                    (pat, expn) = case rules of
-                      [] -> (TH.TupP [], TH.ConE (TH.mkName inner))
-                      _ : [] -> (TH.VarP local,
-                        TH.ConE (TH.mkName inner)
-                        `TH.AppE` TH.VarE local)
-                        where
-                          local = TH.mkName "_x"
-                      ls -> (TH.TupP pats, set)
-                        where
-                          pats = fmap (\i -> TH.VarP (mkName ("_x" ++ show i)))
-                            . take (length ls) $ [(0 :: Int) ..]
-                          set = foldl addVar start . take (length ls)
-                            $ [(0 :: Int) ..]
-                            where
-                              addVar acc i = acc `TH.AppE`
-                                (TH.VarE (TH.mkName ("_x" ++ show i)))
-                              start = TH.ConE (TH.mkName inner)
-
-                getter = TH.LamE [pat] expn
-                  where
-                    local = TH.mkName "_x"
-                    pat = TH.VarP local
-                    expn = TH.CaseE (TH.VarE (TH.mkName "_x")) $
-                      TH.Match patCtor bodyCtor []
-                      : rest
-                      where
-                        patCtor = TH.ConP (TH.mkName inner)
-                          . fmap (\i -> TH.VarP (TH.mkName $ "_y" ++ show i))
-                          . take (length rules)
-                          $ [(0 :: Int) ..]
-                        bodyCtor = TH.NormalB . (TH.ConE 'Right `TH.AppE`)
-                          $ case rules of
-                          [] -> TH.TupE []
-                          _:[] -> TH.VarE (TH.mkName "_y0")
-                          _ -> TH.TupE
-                            . fmap (\i -> TH.VarE (TH.mkName $ "_y" ++ show i))
-                            . take (length rules)
-                            $ [(0 :: Int) ..]
-                        rest = case bs of
-                          [] -> []
-                          _ -> [TH.Match patBlank bodyBlank []]
-                          where
-                            patBlank = TH.VarP (TH.mkName "_z")
-                            bodyBlank = TH.NormalB
-                              $ TH.ConE ('Left)
-                              `TH.AppE` TH.VarE (TH.mkName "_z")
-
-unionToOptics
-  :: String
-  -- ^ Rule name
-  -> Rule t
-  -- ^ First rule
-  -> Seq (Rule t)
-  -- ^ Remaining rules
-  -> TH.DecsQ
-unionToOptics parentName r1 rs
-  = fmap concat . sequence $ optics r1 : fmap optics (toList rs)
-  where
-    optics (Rule r _ _) = sequence $ sig : prism : []
-      where
-        sig = TH.sigD prismName [t| Lens.Prism' $bigType $innerType |]
-        prismName = TH.mkName $ "_" ++ parentName ++ "'" ++ r
-        bigType = TH.conT (TH.mkName parentName)
-        innerType = TH.conT (TH.mkName r)
-        prism = TH.valD (TH.varP prismName)
-          (TH.normalB [| Lens.prism $dataCtor $sToA |] ) []
-        sToA = TH.lamE [pat] expn
-          where
-            pat = dynP "_x"
-            expn = TH.caseE (dyn "_x")
-              [ TH.match (TH.conP (TH.mkName (unionBranchName parentName r))
-                           [TH.varP (TH.mkName "_a")])
-                         (TH.normalB [| Right $(dyn "_a") |]) []
-              , TH.match (dynP "_b")
-                         (TH.normalB [| Left $(dyn "_b") |]) []
-              ]
-        dataCtor = TH.conE (TH.mkName (unionBranchName parentName r))
-
-recordsToOptics
-  :: String
-  -- ^ Rule name
-  -> Seq (Rule t)
-  -> [TH.Dec]
-recordsToOptics nm
-  = concat . zipWith makeLens [(0 :: Int) ..] . toList
-  where
-    makeLens index (Rule inner _ _) = [ signature, function ]
-      where
-        fieldNm = fieldName index nm inner
-        lensName = mkName fieldNm
-        signature = TH.SigD lensName
-          $ (TH.ConT ''Lens.Lens')
-          `TH.AppT` (TH.ConT (TH.mkName nm))
-          `TH.AppT` (TH.ConT (TH.mkName inner))
-
-        function = TH.FunD lensName [TH.Clause [] (TH.NormalB body) []]
-          where
-            namedRec = TH.mkName "_namedRec"
-            namedNewVal = TH.mkName "_namedNewVal"
-            body = (TH.VarE 'Lens.lens) `TH.AppE` getter `TH.AppE` setter
-              where
-                getter = TH.LamE [pat] expn
-                  where
-                    pat = TH.VarP namedRec
-                    expn = (TH.VarE (TH.mkName ('_' : fieldNm)))
-                      `TH.AppE` (TH.VarE namedRec)
-
-                setter = TH.LamE [patRec, patNewVal] expn
-                  where
-                    patRec = TH.VarP namedRec
-                    patNewVal = TH.VarP namedNewVal
-                    expn = TH.RecUpdE (TH.VarE namedRec)
-                      [ (TH.mkName ('_' : fieldNm), TH.VarE namedNewVal) ]
-
-
-ruleToOptics
-  :: Syntax.Lift t
-  => Name
-  -- ^ Terminal type name
-  -> String
-  -- ^ Rule name
-  -> RuleType t
-  -> TH.DecsQ
-ruleToOptics terminalName nm ty = case ty of
-  RTerminal ivl -> terminalToOptics terminalName nm ivl
-  RBranch (b1, bs) -> return $ branchesToOptics nm b1 bs
-  RUnion (r1, rs) -> unionToOptics nm r1 rs
-  RSeqTerm sq -> seqTermToOptics terminalName nm sq
-  ROptional (Rule inner _ _) -> return [optionalToOptics inner nm]
-  RList (Rule inner _ _) -> return [manyToOptics inner nm]
-  RList1 (Rule inner _ _) -> return [many1ToOptics inner nm]
-  RWrap (Rule inner _ _) -> return [wrapToOptics inner nm]
-  RRecord recs -> return $ recordsToOptics nm recs
-
--- | Should optics be made?
-type MakeOptics = Bool
-
--- | Creates optics.
---
--- If you use this option, you will need
--- @
--- \{\-\# LANGUAGE TypeFamilies \#\-\}
--- @
---
--- at the top of the module into which you splice in the
--- declarations, because you will get instances of 'Lens.Wrapped'.
---
--- Creates the listed optics for each kind of
--- 'Rule', as follows:
---
--- * 'terminal': @'Lens.Prism'' a b@, where @a@ is the type of the
--- terminal token (often 'Char') and @b@ is the type of this
--- particular production.  For an example, see
--- 'Pinchot.Examples.PostalAstAllRules._Comma'.
---
--- >>> ',' ^? _Comma
--- Just (Comma ',')
--- >>> 'a' ^? _Comma
--- Nothing
--- >>> Comma ',' ^. re _Comma
--- ','
---
--- Thus this gives you a safe way to insert tokens into types made
--- with 'terminal' (useful if you want to construct a syntax tree.)
---
--- * 'terminalSeq': @'Lens.Prism'' ('Seq' a) b@, where @a@ is the type
--- of the terminal token (often 'Char') and @b@ is the type of this
--- particular production.  As with 'terminal' this gives you a safe
--- way to insert values into the types made with 'terminalSeq'.
---
--- * 'nonTerminal': one 'Lens.Prism'' for each data constructor (even if
--- there is only one data constructor)
---
--- * 'union': one 'Lens.Prism' for each data constructor (even if
--- there is only one data constructor)
---
--- * 'record': one 'Lens.Lens' for each field
---
--- * 'list': 'Lens.Wrapped', wrapping a @'Seq' a@
---
--- * 'list1': 'Lens.Wrapped', wrapping a pair @(a, 'Seq' a)@
---
--- * 'option': 'Lens.Wrapped', wrapping a @'Maybe' a@
---
--- * 'wrap': 'Lens.Wrapped', wrapping the underlying type
-makeOptics :: MakeOptics
-makeOptics = True
-
--- | Do not make any optics.
-noOptics :: MakeOptics
-noOptics = False
-
--- | Creates data types for every 'Rule' created in the 'Pinchot'.  The data
--- types are created in the same order in which they were created in
--- the 'Pinchot'.  When spliced, the 'DecsQ' is a list of
--- declarations, each of which is an appropriate @data@ or @newtype@.
--- For an example use of 'allRulesToTypes', see
--- "Pinchot.Examples.PostalAstAllRules".
---
--- Also creates bindings whose names are prefixed with @t'@.  Each
--- of these is a function that, when given a particular production,
--- reduces it to a sequence of terminal symbols.
-
-allRulesToTypes
-  :: Syntax.Lift t
-  => MakeOptics
-
-  -> Name
-  -- ^ Terminal type constructor name.  Typically you will use the
-  -- Template Haskell quoting mechanism to get this.
-
-  -> Seq Name
-  -- ^ What to derive.  For instance, you might use @Eq@, @Ord@, and
-  -- @Show@ here.  Each created data type will derive these instances.
-
-  -> Pinchot t a
-  -- ^ The return value from the 'Pinchot' is ignored.
-
-  -> DecsQ
-allRulesToTypes doOptics typeName derives pinchot = do
-  st' <- fmap fst $ goPinchot pinchot
-  thAllRules doOptics typeName derives (allRules st')
-
--- | Creates data types only for the 'Rule' returned from the 'Pinchot', and
--- for its ancestors.
---
--- Also creates bindings whose names are prefixed with @t'@.  Each
--- of these is a function that, when given a particular production,
--- reduces it to a sequence of terminal symbols.
-ruleTreeToTypes
-  :: Syntax.Lift t
-  => MakeOptics
-
-  -> Name
-  -- ^ Terminal type constructor name.  Typically you will use the
-  -- Template Haskell quoting mechanism to get this.
-
-  -> Seq Name
-  -- ^ What to derive.  For instance, you might use @Eq@, @Ord@, and
-  -- @Show@ here.  Each created data type will derive these instances.
-
-  -> Pinchot t (Rule t)
-  -- ^ A data type is created for the 'Rule' that the 'Pinchot'
-  -- returns, and for the ancestors of the 'Rule'.
-  -> DecsQ
-ruleTreeToTypes doOptics typeName derives pinchot = do
-  r <- fmap snd $ goPinchot pinchot
-  fmap join . sequence . toList
-    . fmap (thRule doOptics typeName derives)
-    . runCalc . getAncestors $ r
-  where
-    runCalc stateCalc = fst $ runState stateCalc Set.empty
-
-addPrefix
-  :: String
-  -> String
-  -> String
-addPrefix pfx suf
-  | null pfx = suf
-  | otherwise = pfx ++ '.':suf
-
-ruleToParser
-  :: Syntax.Lift t
-  => String
-  -- ^ Module prefix
-  -> Rule t
-  -> [(Name, ExpQ)]
-ruleToParser prefix (Rule nm mayDescription rt) = case rt of
-
-  RTerminal ivls -> [makeRule expression]
-    where
-      expression = [| fmap $constructor (satisfy (inIntervals ivls)) |]
-
-  RBranch (b1, bs) -> [makeRule expression]
-    where
-      expression = foldl addBranch (branchToParser prefix b1) bs
-        where
-          addBranch tree branch =
-            [| $tree <|> $(branchToParser prefix branch) |]
-
-  RUnion (Rule r1 _ _, rs) -> [makeRule expression]
-    where
-      expression = foldl adder start rs
-        where
-          branch r = [| $(conE (mkName
-            (addPrefix prefix . unionBranchName nm $ r))) <$>
-            $(varE (ruleName r)) |]
-          start = branch r1
-          adder soFar (Rule r _ _) = [| $soFar <|> $(branch r) |]
-
-  RSeqTerm sq -> [nestRule, topRule]
-    where
-      nestRule = (helper, [| rule $(foldl addTerm start sq) |])
-        where
-          start = [|pure Seq.empty|]
-          addTerm acc x = [| liftA2 (<|) (symbol x) $acc |]
-      topRule = makeRule (wrapper helper)
-
-  ROptional (Rule innerNm _ _) -> [makeRule expression]
-    where
-      expression = [| fmap $constructor (pure Nothing <|> $(just)) |]
-        where
-          just = [| fmap Just $(varE (ruleName innerNm)) |]
-
-  RList (Rule innerNm _ _) -> [nestRule, makeRule (wrapper helper)]
-    where
-      nestRule = (helper, ([|rule|] `appE` parseSeq))
-        where
-          parseSeq = uInfixE [|pure Seq.empty|] [|(<|>)|] pSeq
-            where
-              pSeq = [|liftA2 (<|) $(varE (ruleName innerNm)) $(varE helper) |]
-
-  RList1 (Rule innerNm _ _) -> [nestRule, makeRule topExpn]
-    where
-      nestRule = (helper, [|rule $(parseSeq)|])
-        where
-          parseSeq = [| pure Seq.empty <|> $pSeq |]
-            where
-              pSeq = [| (<|) <$> $(varE (ruleName innerNm))
-                             <*> $(varE helper) |]
-      topExpn = [| $constructor <$> ( (,) <$> $(varE (ruleName innerNm))
-                                        <*> $(varE helper)
-                                    ) |]
-
-  RWrap (Rule innerNm _ _) -> [makeRule expression]
-    where
-      expression = [|fmap $constructor $(varE (ruleName innerNm)) |]
-
-  RRecord sq -> [makeRule expression]
-    where
-      expression = case viewl sq of
-        EmptyL -> [| pure $constructor |]
-        Rule r1 _ _ :< restFields -> foldl addField fstField restFields
-          where
-            fstField = [| $constructor <$> $(varE (ruleName r1)) |]
-            addField soFar (Rule r _ _)
-              = [| $soFar <*> $(varE (ruleName r)) |]
-    
-
-  where
-    makeRule expression = (ruleName nm,
-      [|rule ($expression Text.Earley.<?> $(textToExp desc))|])
-    desc = maybe nm id mayDescription
-    textToExp txt = [| $(Syntax.lift txt) |]
-    constructor = constructorName prefix nm
-    wrapper wrapRule = [|fmap $constructor $(varE wrapRule) |]
-    helper = helperName nm
-
-
-constructorName
-  :: String
-  -- ^ Module prefix
-  -> String
-  -- ^ Name of constructor
-  -> ExpQ
-constructorName pfx nm = conE (mkName name)
-  where
-    name = pfx' ++ nm
-    pfx'
-      | null pfx = ""
-      | otherwise = pfx ++ "."
-
-ruleName :: String -> Name
-ruleName suffix = mkName ("_rule'" ++ suffix)
-
-helperName :: String -> Name
-helperName suffix = mkName ("_helper'" ++ suffix)
-
-branchToParser
-  :: Syntax.Lift t
-  => String
-  -- ^ Module prefix
-  -> Branch t
-  -> ExpQ
-branchToParser prefix (Branch name rules) = case viewl rules of
-  EmptyL -> [| pure $constructor |]
-  (Rule rule1 _ _) :< xs -> foldl f z xs
-    where
-      z = [| $constructor <$> $(varE (ruleName rule1)) |]
-      f soFar (Rule rule2 _ _) = [| $soFar <*> $(varE (ruleName rule2)) |]
-  where
-    constructor = constructorName prefix name
-
--- # lazyPattern and bigTuple - because TH has no support for
--- mdo notation
-    
--- | Creates a lazy pattern for all the given names.  Adds an empty
--- pattern onto the front.  This is the counterpart of 'bigTuple'.
--- All of the given names are bound.  In addition, a single,
--- wildcard pattern is bound to the front.
--- 
--- For example, @lazyPattern (map mkName ["x", "y", "z"])@ gives a
--- pattern that looks like
---
--- @~(_, (x, (y, (z, ()))))@
---
--- The idea is that the named patterns are needed so that the
--- recursive @do@ notation works, and that the wildcard pattern is
--- the return value, which is not needed here.
-lazyPattern
-  :: Foldable c
-  => c Name
-  -> Q Pat
-lazyPattern = finish . foldr gen [p| () |]
-  where
-    gen name rest = [p| ($(varP name), $rest) |]
-    finish pat = [p| ~(_, $pat) |]
-
--- | Creates a big tuple.  It is nested in the second element, such
--- as (1, (2, (3, (4, ())))).  Thus, the big tuple is terminated
--- with a unit value.  It resembles a list where each tuple is a
--- cons cell and the terminator is unit.
-bigTuple
-  :: Foldable c
-  => ExpQ
-  -- ^ This expression will be the first one in the tuple.
-  -> c ExpQ
-  -- ^ Remaining expressions in the tuple.
-  -> ExpQ
-bigTuple top = finish . foldr f [| () |]
-  where
-    f n rest = [| ( $(n), $rest) |]
-    finish tup = [| ($(top), $tup) |]
-
--- | Creates an Earley grammar for a given 'Rule'.  For examples of how
--- to use this, see the source code for
--- "Pinchot.Examples.PostalAstRuleTree" and for
--- "Pinchot.Examples.PostalAstAllRules".
-
-earleyGrammar
-  :: Syntax.Lift t
-
-  => Qualifier
-  -- ^ Qualifier for data types crated with 'ruleTreeToTypes' or
-  -- 'allRulesToTypes'
-
-  -> Pinchot t (Rule t)
-  -- ^ Creates an Earley parser for the 'Rule' that the 'Pinchot'
-  -- returns.
-
-  -> Q Exp
-  -- ^ When spliced, this expression has type
-  -- @'Text.Earley.Grammar' r ('Text.Earley.Prod' r 'String' t a)@
-  --
-  -- where
-  -- 
-  -- @r@ is left universally quantified
-  --
-  -- @t@ is the type of the token (usually 'Char')
-  --
-  -- @a@ is the type defined by the 'Rule'.
-earleyGrammar prefix pinc = do
-  r <- fmap snd $ goPinchot pinc
-  earleyGrammarFromRule prefix r
-
--- | Builds a recursive @do@ expression (because TH has no support
--- for @mdo@ notation).
-recursiveDo
-  :: [(Name, ExpQ)]
-  -- ^ Binding statements
-  -> ExpQ
-  -- ^ Final return value from @do@ block.  The type of this 'ExpQ'
-  -- must be in the same monad as the @do@ block; it must not be a
-  -- pure value.
-  -> ExpQ
-  -- ^ Returns an expression whose value is the final return value
-  -- from the @do@ block.
-recursiveDo binds final = [| fmap fst $ mfix $(fn) |]
-  where
-    fn = [| \ $(lazyPattern (fmap fst binds)) -> $doBlock |]
-    doBlock = TH.doE (bindStmts ++ returnStmts)
-    bindStmts = map mkBind binds
-      where
-        mkBind (name, exp)
-          = TH.bindS (TH.varP name) exp
-    returnStmts = [bindRtnVal, returner]
-      where
-        rtnValName = TH.mkName "_returner"
-        bindRtnVal = TH.bindS (TH.varP rtnValName) final
-        returner
-          = TH.noBindS
-            [| return $(bigTuple (TH.varE rtnValName) 
-                                 (fmap (TH.varE . fst) binds)) |]
-
-earleyGrammarFromRule
-  :: Syntax.Lift t
-  => String
-  -- ^ Module prefix
-  -> Rule t
-  -> Q Exp
-earleyGrammarFromRule prefix r@(Rule top _ _) = recursiveDo binds final
-  where
-    binds = concatMap (ruleToParser prefix) . toList . ruleAndAncestors $ r
-    final = [| return $(TH.varE $ ruleName top) |]
-
--- | Creates an Earley grammar for each 'Rule' created in a
--- 'Pinchot'.  For a 'Pinchot' with a large number of 'Rule's, this
--- can create a large number of declarations that can take a long
--- time to compile--sometimes several minutes.  For lower
--- compilation times, try 'earleyProduct'.
-
-allEarleyGrammars
-  :: Syntax.Lift t
-
-  => Qualifier
-  -- ^ Qualifier for data types created with 'ruleTreeToTypes' or
-  -- 'allRulesToTypes'
-
-  -> Name
-  -- ^ Name for the terminal type; often this is 'Char'.  Typically
-  -- you will use the Template Haskell quoting mechanism--for
-  -- example, @\'\'Char@.
-
-  -> Pinchot t a
-  -- ^ Creates an Earley grammar for each 'Rule' created in the
-  -- 'Pinchot'.  The return value of the 'Pinchot' computation is
-  -- ignored.
-
-  -> DecsQ
-  -- ^ When spliced, this is a list of declarations.  Each
-  -- declaration has type
-  -- @'Text.Earley.Grammar' r ('Text.Earley.Prod' r 'String' t a)@
-  --
-  -- where
-  -- 
-  -- @r@ is left universally quantified
-  --
-  -- @t@ is the type of the token (usually 'Char')
-  --
-  -- @a@ is the type defined by the 'Rule'.
-  --
-  -- The name of each declaration is
-  -- g'TYPE_NAME
-  --
-  -- where TYPE_NAME is the name of the type defined in the
-  -- corresponding 'Rule'.
-allEarleyGrammars prefix termName pinc = do
-  st <- fmap fst $ goPinchot pinc
-  sequence . concat . fmap makeDecl . fmap snd . M.toList
-    . allRules $ st
-  where
-    makeDecl rule@(Rule nm _ _) = [signature, TH.valD pat body []]
-      where
-        signature = TH.sigD name types
-        r = TH.mkName "r"
-        types = TH.forallT [TH.PlainTV r] (return [])
-          $ [t| Text.Earley.Grammar $(TH.varT r)
-              (Text.Earley.Prod $(TH.varT r) String $(TH.conT termName)
-                                         $(TH.conT qualRuleName)) |]
-        name = TH.mkName $ "g'" ++ nm
-        pat = TH.varP name
-        body = TH.normalB (earleyGrammarFromRule prefix rule)
-        qualRuleName
-          | null prefix = TH.mkName nm
-          | otherwise = TH.mkName (prefix ++ "." ++ nm)
-
-
-prodDeclName :: String -> TH.Name
-prodDeclName name = TH.mkName $ "t'" ++ name
-
-prodFn :: String -> TH.ExpQ
-prodFn = TH.varE . prodDeclName
-
-addIndices :: Foldable c => c a -> [(Int, a)]
-addIndices = zip [0..] . toList
-
--- | Creates a production declaration for a 'Rule'.
-productionDecl
-  :: String
-  -- ^ Rule name
-  -> Name
-  -- ^ Name of terminal type
-  -> RuleType t
-  -> TH.DecsQ
-productionDecl n termType t
-  = sequence [signature, TH.funD (prodDeclName n) clauses]
-  where
-    signature = TH.sigD (prodDeclName n) types
-      where
-        types = TH.appT (TH.appT TH.arrowT (TH.conT (TH.mkName n)))
-          (TH.appT (TH.conT ''Seq) (TH.conT termType))
-    clauses = case t of
-      RTerminal _ -> [TH.clause [pat] bdy []]
-        where
-          pat = TH.conP (TH.mkName n) [TH.varP (TH.mkName "_x")]
-          bdy = TH.normalB [| Seq.singleton $(TH.varE (TH.mkName "_x")) |]
-
-      RBranch (b1, bs) -> branchToClause b1
-        : fmap branchToClause (toList bs)
-
-      RSeqTerm _ -> [TH.clause [pat] bdy []]
-        where
-          pat = TH.conP (TH.mkName n) [TH.varP (TH.mkName "_x")]
-          bdy = TH.normalB (dyn "_x")
-
-      ROptional (Rule inner _ _) -> [justClause, nothingClause]
-        where
-          justClause
-            = TH.clause [TH.conP (TH.mkName n)
-                [TH.conP 'Just [TH.varP (TH.mkName "_b")]]]
-                (TH.normalB [| $(prodFn inner)
-                               $(TH.varE (TH.mkName "_b")) |])
-                []
-          nothingClause
-            = TH.clause [TH.conP (TH.mkName n)
-                [TH.conP 'Nothing []]]
-                (TH.normalB [| Seq.empty |]) []
-
-      RList (Rule inner _ _) -> [TH.clause [pat] bdy []]
-        where
-          pat = TH.conP (TH.mkName n) [TH.varP (TH.mkName "_a")] 
-          bdy = TH.normalB [| join
-            $ fmap $(prodFn inner) $(TH.varE (TH.mkName "_a")) |]
-
-      RList1 (Rule inner _ _) -> [TH.clause [pat] bdy []]
-        where
-          pat = TH.conP (TH.mkName n)
-            [TH.tupP [ dynP "_x1", dynP "_xs" ]]
-          bdy = TH.normalB
-            [| $lft `mappend` (join (fmap $(prodFn inner)
-                $(dyn "_xs"))) |]
-            where
-              lft = [| $(prodFn inner) $(dyn "_x1") |]
-
-      RWrap (Rule inner _ _) -> [TH.clause [pat] bdy []]
-        where
-          pat = TH.conP (TH.mkName n) [dynP "_x"]
-          bdy = TH.normalB [| $(prodFn inner) $(dyn "_x") |]
-
-      RRecord sq -> [TH.clause [pat] (TH.normalB bdy) []]
-        where
-          pat = TH.conP (TH.mkName n) . fmap mkPat
-            . fmap fst . addIndices $ sq
-            where
-              mkPat idx = dynP ("_x'" ++ show idx)
-          bdy = foldr addField [| Seq.empty |] . addIndices $ sq
-            where
-              addField (idx, (Rule nm _ _)) acc = [| $this `mappend` $acc |]
-                where
-                  this = [| $(prodFn nm) $(dyn ("_x'" ++ show idx)) |]
-
-      RUnion (r1, rs) -> mkClause r1 : fmap mkClause (toList rs)
-        where
-          mkClause (Rule inner _ _) = TH.clause [pat] bdy []
-            where
-              pat = TH.conP (TH.mkName (unionBranchName n inner))
-                [dynP "_x"]
-              bdy = TH.normalB [| $(prodFn inner) $(dyn "_x") |]
-
-
-branchToClause :: Branch t -> TH.ClauseQ
-branchToClause (Branch n rs) = TH.clause [pat] bdy []
-  where
-    pat = TH.conP (TH.mkName n) fields
-      where
-        fields = fmap mkField . fmap fst . addIndices $ rs
-          where
-            mkField idx = TH.varP (TH.mkName ("_x'" ++ show idx))
-    bdy = TH.normalB [| join $sq |]
-      where
-        sq = foldr addField (TH.varE 'Seq.empty) . addIndices $ rs
-          where
-            addField (idx, (Rule inner _ _)) acc = [| $newTerm <| $acc |]
-              where
-                newTerm = [| $(prodFn inner) $(TH.varE
-                              (TH.mkName ("_x'" ++ show idx))) |]
-
--- | Many functions take an argument that holds the name qualifier
--- for the module that contains the data types created by applying
--- 'ruleTreeToTypes' or 'allRulesToTypes' to the 'Pinchot.'
---
--- You have to make sure that the data types you created with
--- 'ruleTreeToTypes', 'allRulesToTypes', or 'allRulesRecord' are in
--- scope.  The spliced Template Haskell code has to know where to
--- look for these data types.  If you did an unqualified @import@ or
--- if the types are in the same module as is the splice of
--- 'earleyParser', just pass the empty string here.  If you did a
--- qualified import, use the appropriate qualifier here.
---
--- For example, if you used @import qualified MyAst@, pass
--- @\"MyAst\"@ here.  If you used @import qualified
--- Data.MyLibrary.MyAst as MyLibrary.MyAst@, pass
--- @\"MyLibrary.MyAst\"@ here.
---
--- I recommend that you always create a new module and that all you
--- do in that module is apply 'ruleTreeToTypes' or
--- 'allRulesToTypes', and that you then perform an @import
--- qualified@ to bring those names into scope in the module in which
--- you use a function that takes a 'Qualifier' argument.  This
--- avoids unlikely, but possible, issues that could otherwise arise
--- due to naming conflicts.
-type Qualifier = String
-
-
--- | Creates a record data type that holds a value of type
---
--- @'Text.Earley.Prod' r 'String' t a@
---
--- for every rule created in the 'Pinchot'.  @r@ is left
--- universally quantified, @t@ is the token type (typically 'Char')
--- and @a@ is the type of the rule.
---
--- This always creates a single product type whose name is
--- @Productions@; currently the name cannot be configured.
---
--- For an example of the use of 'allRulesRecord', please see
--- "Pinchot.Examples.AllRulesRecord".
-allRulesRecord
-  :: Qualifier
-  -- ^ Qualifier for data types created with 'ruleTreeToTypes' or
-  -- 'allRulesToTypes'
-  -> Name
-  -- ^ Name of terminal type.  Typically you will get this through
-  -- the Template Haskell quoting mechanism, such as @''Char@.
-  -> Pinchot t a
-  -- ^ A record is created that holds a value for each 'Rule'
-  -- created in the 'Pinchot'; the return value of the 'Pinchot' is
-  -- ignored.
-  -> DecsQ
-  -- ^ When spliced, this will create a single declaration that is a
-  -- record with the name @Productions@.  It will have one type variable,
-  -- @r@.  Each record in the declaration will have a name like so:
-  --
-  -- @a'NAME@
-  --
-  -- where @NAME@ is the name of the type.  Don't count on these
-  -- records being in any particular order.
-allRulesRecord prefix termName pinc
-  = sequence [TH.dataD (return []) (TH.mkName nameStr) tys [con] []]
-  where
-    nameStr = "Productions"
-    tys = [TH.PlainTV (TH.mkName "r")]
-    con = do
-      names <- fmap fst $ goPinchot pinc
-      TH.recC (TH.mkName nameStr)
-        (fmap (mkRecord . snd) . M.assocs . allRules $ names)
-    mkRecord (Rule ruleNm _ _) = TH.varStrictType recName st
-      where
-        recName = TH.mkName ("a'" ++ ruleNm)
-        st = TH.strictType TH.notStrict ty
-          where
-            ty = (TH.conT ''Text.Earley.Prod)
-              `TH.appT` (TH.varT (TH.mkName "r"))
-              `TH.appT` (TH.conT ''String)
-              `TH.appT` (TH.conT termName)
-              `TH.appT` (TH.conT (TH.mkName nameWithPrefix))
-            nameWithPrefix = case prefix of
-              [] -> ruleNm
-              _ -> prefix ++ '.' : ruleNm
-
--- | Creates a 'Text.Earley.Grammar' that contains a
--- 'Text.Earley.Prod' for every 'Rule' created in the 'Pinchot'.
-earleyProduct
-  :: Syntax.Lift t
-
-  => Qualifier
-  -- ^ Qualifier for data types created with 'ruleTreeToTypes' or
-  -- 'allRulesToTypes'
-
-  -> Qualifier
-  -- ^ Module prefix for the type created with 'allRulesRecord'
-
-  -> Pinchot t a
-  -- ^ Creates an Earley grammar that contains a 'Text.Earley.Prod'
-  -- for each 'Rule' in the 'Pinchot'.  The return value from the
-  -- 'Pinchot' is ignored.
-
-  -> ExpQ
-  -- ^ When spliced, 'earleyProduct' creates an expression whose
-  -- type is @'Text.Earley.Grammar' r (Productions r)@, where
-  -- @Productions@ is
-  -- the type created by 'allRulesRecord'.
-earleyProduct pfxRule pfxRec pinc = do
-  names <- fmap fst $ goPinchot pinc
-  let binds = concatMap (ruleToParser pfxRule)
-        . fmap snd . M.assocs . allRules $ names
-      final = [| return
-        $(TH.recConE (TH.mkName rulesRecName) (recs names)) |]
-  recursiveDo binds final
-  where
-    rulesRecName
-      | null pfxRec = "Productions"
-      | otherwise = pfxRec ++ ".Productions"
-    recs = fmap mkRec . fmap snd . M.assocs . allRules
-      where
-        mkRec (Rule n _ _) = return (TH.mkName recName, recVal)
-          where
-            recName
-              | null pfxRec = "a'" ++ n
-              | otherwise = pfxRec ++ ".a'" ++ n
-            recVal = TH.VarE . ruleName $ n
diff --git a/lib/Pinchot/Intervals.hs b/lib/Pinchot/Intervals.hs
--- a/lib/Pinchot/Intervals.hs
+++ b/lib/Pinchot/Intervals.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_HADDOCK not-home #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -6,6 +7,7 @@
 -- usually need.
 module Pinchot.Intervals where
 
+import qualified Control.Lens as Lens
 import Control.Monad (join)
 import Data.Monoid ((<>))
 import Data.Ord (comparing)
@@ -19,17 +21,19 @@
 -- 'mappend', which will combine both the included and excluded
 -- terminal symbols from each operand.
 data Intervals a = Intervals
-  { included :: Seq (a, a)
+  { _included :: Seq (a, a)
   -- ^ Each pair @(a, b)@ is an inclusive range of terminal symbols,
   -- in order.  For instance, @('a', 'c')@ includes the characters
   -- @'a'@, @'b'@, and @'c'@.  The 'included' sequence contains all
   -- terminals that are included in the 'Intervals', except for those
   -- that are 'excluded'.
-  , excluded :: Seq (a, a)
+  , _excluded :: Seq (a, a)
   -- ^ Each symbol in 'excluded' is not in the 'Intervals', even if
   -- the symbol is 'included'.
   } deriving (Eq, Ord, Show)
 
+Lens.makeLenses ''Intervals
+
 instance Functor Intervals where
   fmap f (Intervals a b) = Intervals (fmap g a) (fmap g b)
     where
@@ -42,7 +46,7 @@
 
 -- | Include a range of symbols in the 'Intervals'.  For instance, to
 -- include the characters @'a'@, @'b'@, and @'c'@, use @include 'a'
--- 'c'@.
+-- 'c'@.  Example: 'Pinchot.Examples.Postal.rLetter'.
 include :: a -> a -> Intervals a
 include l h = Intervals [(l, h)] []
 
@@ -52,7 +56,8 @@
 exclude :: a -> a -> Intervals a
 exclude l h = Intervals [] [(l, h)]
 
--- | Include a single symbol.
+-- | Include a single symbol.  Example:
+-- 'Pinchot.Examples.Postal.rNorth'.
 solo :: a -> Intervals a
 solo x = Intervals [(x, x)] []
 
diff --git a/lib/Pinchot/Locator.hs b/lib/Pinchot/Locator.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Locator.hs
@@ -0,0 +1,59 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+module Pinchot.Locator where
+
+import Pinchot.Types
+
+import qualified Data.ListLike as ListLike
+import Data.Sequence (Seq, (|>))
+import qualified Data.Sequence as Seq
+import qualified Text.Earley as Earley
+
+-- | Advances the location for 'Char' values.  Tabs advance to the
+-- next eight-column tab stop; newlines advance to the next line and
+-- reset the column number to 1.  All other characters advance the
+-- column by 1.
+advanceChar :: Char -> Loc -> Loc
+advanceChar c (Loc !lin !col !pos)
+  | c == '\n' = Loc (lin + 1) 1 (pos + 1)
+  | c == '\t' = Loc lin (col + 8 - ((col - 1) `mod` 8)) (pos + 1)
+  | otherwise = Loc lin (col + 1) (pos + 1)
+
+-- | Takes any ListLike value based on 'Char' (@Seq@, @Text@,
+-- @String@, etc.) and creates a 'Seq' which pairs each 'Char' with
+-- its location.  Example: 'locatedFullParses'.
+locations
+  :: ListLike.FoldableLL full Char
+  => full
+  -> Seq (Char, Loc)
+locations = fst . ListLike.foldl' f (Seq.empty, Loc 1 1 1)
+  where
+    f (!sq, !loc) c = (sq |> (c, loc), advanceChar c loc)
+
+-- | Breaks a ListLike into a 'Seq' but does not assign locations.
+noLocations
+  :: ListLike.FoldableLL full item
+  => full
+  -> Seq (item, ())
+noLocations = ListLike.foldl' f Seq.empty
+  where
+    f !sq c = sq |> (c, ())
+
+-- | Obtains all full Earley parses from a given input string, after
+-- assigning a location to every 'Char'.  Example:
+-- 'Pinchot.Examples.Newman.address'.
+locatedFullParses
+  :: ListLike.FoldableLL full Char
+  => (forall r. Earley.Grammar r (Earley.Prod r String (Char, Loc) (p Char Loc)))
+  -- ^ Earley grammar with production that you want to parse.
+  -> full
+  -- ^ Source text, e.g. 'String', 'Data.Text', etc.
+  -> ([p Char Loc], Earley.Report String (Seq (Char, Loc)))
+  -- ^ A list of successful parses that when to the end of the
+  -- source string, along with the Earley report showing possible
+  -- errors.
+locatedFullParses g
+  = Earley.fullParses (Earley.parser g)
+  . locations
diff --git a/lib/Pinchot/NonEmpty.hs b/lib/Pinchot/NonEmpty.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/NonEmpty.hs
@@ -0,0 +1,61 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+-- | Sequences that always contain at least one element.
+
+module Pinchot.NonEmpty where
+
+import Control.Monad (join, ap)
+import Data.Sequence (Seq, (<|))
+import qualified Data.Sequence as Seq
+import qualified Control.Lens as Lens
+
+-- | A non-empty sequence.
+data NonEmpty a = NonEmpty
+  { _front :: a
+  -- ^ The first item
+  , _rest :: Seq a
+  -- ^ All remaining items
+  } deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+Lens.makeLenses ''NonEmpty
+
+-- | Convert a 'NonEmpty' to a 'Seq'.
+flatten :: NonEmpty a -> Seq a
+flatten (NonEmpty a as) = a <| as
+
+instance Monad NonEmpty where
+  return a = NonEmpty a Seq.empty
+  NonEmpty a as >>= f = NonEmpty (_front r1) rs
+    where
+      r1 = f a
+      rs = _rest r1 `mappend` rss
+      rss = join . fmap flatten . fmap f $ as
+
+instance Applicative NonEmpty where
+  pure = return
+  (<*>) = ap
+
+-- | Converts a non-empty 'Seq' to a 'NonEmpty'; 'Nothing' if the
+-- 'Seq' is empty.
+seqToNonEmpty :: Seq a -> Maybe (NonEmpty a)
+seqToNonEmpty = fmap (uncurry NonEmpty) . Lens.uncons
+
+-- | Prepends a 'Seq' to a 'NonEmpty'.
+prependSeq :: Seq a -> NonEmpty a -> NonEmpty a
+prependSeq sq (NonEmpty a as) = case Lens.uncons sq of
+  Nothing -> NonEmpty a as
+  Just (l, ls) -> NonEmpty l (ls `mappend` (a <| as))
+
+-- | Appends a 'Seq' to a 'NonEmpty'.
+appendSeq :: NonEmpty a -> Seq a -> NonEmpty a
+appendSeq (NonEmpty a as) sq = NonEmpty a (as `mappend` sq)
+
+-- | Associative operation that appends to 'NonEmpty'.
+append :: NonEmpty a -> NonEmpty a -> NonEmpty a
+append (NonEmpty l1 ls) (NonEmpty r1 rs)
+  = NonEmpty l1 (ls `mappend` (r1 <| rs))
+
+-- | Place a single item at the head of the 'NonEmpty'.
+singleton :: a -> NonEmpty a
+singleton a = NonEmpty a Seq.empty
diff --git a/lib/Pinchot/RecursiveDo.hs b/lib/Pinchot/RecursiveDo.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/RecursiveDo.hs
@@ -0,0 +1,76 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Emulating recursive do notation, as TH does not support it.
+module Pinchot.RecursiveDo where
+
+import Control.Monad.Fix (mfix)
+import qualified Language.Haskell.TH as T
+
+-- | Creates a lazy pattern for all the given names.  Adds an empty
+-- pattern onto the front.  This is the counterpart of 'bigTuple'.
+-- All of the given names are bound.  In addition, a single,
+-- wildcard pattern is bound to the front.
+-- 
+-- For example, @lazyPattern (map mkName ["x", "y", "z"])@ gives a
+-- pattern that looks like
+--
+-- @~(_, (x, (y, (z, ()))))@
+--
+-- The idea is that the named patterns are needed so that the
+-- recursive @do@ notation works, and that the wildcard pattern is
+-- the return value, which is not needed here.
+lazyPattern
+  :: Foldable c
+  => c T.Name
+  -> T.Q T.Pat
+lazyPattern = finish . foldr gen [p| () |]
+  where
+    gen name rest = [p| ($(T.varP name), $rest) |]
+    finish pat = [p| ~(_, $pat) |]
+
+-- | Creates a big tuple.  It is nested in the second element, such
+-- as (1, (2, (3, (4, ())))).  Thus, the big tuple is terminated
+-- with a unit value.  It resembles a list where each tuple is a
+-- cons cell and the terminator is unit.
+bigTuple
+  :: Foldable c
+  => T.ExpQ
+  -- ^ This expression will be the first one in the tuple.
+  -> c T.ExpQ
+  -- ^ Remaining expressions in the tuple.
+  -> T.ExpQ
+bigTuple top = finish . foldr f [| () |]
+  where
+    f n rest = [| ( $(n), $rest) |]
+    finish tup = [| ($(top), $tup) |]
+
+-- | Builds a recursive @do@ expression (because TH has no support
+-- for @mdo@ notation).
+recursiveDo
+  :: [(T.Name, T.ExpQ)]
+  -- ^ Binding statements
+  -> T.ExpQ
+  -- ^ Final return value from @do@ block.  The type of this 'ExpQ'
+  -- must be in the same monad as the @do@ block; it must not be a
+  -- pure value.
+  -> T.ExpQ
+  -- ^ Returns an expression whose value is the final return value
+  -- from the @do@ block.
+recursiveDo binds final = [| fmap fst $ mfix $(fn) |]
+  where
+    fn = [| \ $(lazyPattern (fmap fst binds)) -> $doBlock |]
+    doBlock = T.doE (bindStmts ++ returnStmts)
+    bindStmts = map mkBind binds
+      where
+        mkBind (name, exp)
+          = T.bindS (T.varP name) exp
+    returnStmts = [bindRtnVal, returner]
+      where
+        rtnValName = T.mkName "_returner"
+        bindRtnVal = T.bindS (T.varP rtnValName) final
+        returner
+          = T.noBindS
+            [| return $(bigTuple (T.varE rtnValName) 
+                                 (fmap (T.varE . fst) binds)) |]
+
diff --git a/lib/Pinchot/Rules.hs b/lib/Pinchot/Rules.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Rules.hs
@@ -0,0 +1,223 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE OverloadedLists #-}
+module Pinchot.Rules where
+
+import qualified Control.Lens as Lens
+import Control.Monad (join)
+import Control.Monad.Trans.State (get, put, State)
+import qualified Control.Monad.Trans.State as State
+import Data.Monoid ((<>))
+import Data.Sequence (Seq, (<|))
+import qualified Data.Sequence as Seq
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Pinchot.Types
+import Pinchot.Intervals
+
+-- | Name a 'Rule' for use in error messages.  If you do not name a
+-- rule using this combinator, the rule's type name will be used in
+-- error messages.
+label :: Rule t -> String -> Rule t
+label (Rule n _ t) s = Rule n (Just s) t
+
+-- | Infix synonym for 'label'.  Example:
+-- 'Pinchot.Examples.Postal.rDigit'.
+(<?>) :: Rule t -> String -> Rule t
+(<?>) = label
+infixr 0 <?>
+
+-- | Constructs a 'Rule' with no description.
+rule :: RuleName -> RuleType t -> Rule t
+rule n = Rule n Nothing
+
+-- | Creates a terminal production rule.  Example:
+-- 'Pinchot.Examples.Postal.rLetter'.
+terminal
+  :: RuleName
+  -> Intervals t
+  -- ^ Valid terminal symbols
+  -> Rule t
+terminal n i = rule n (Terminal i)
+
+-- | Creates a non-terminal production rule.  This is the most
+-- flexible way to create non-terminals.  You can even create a
+-- non-terminal that depends on itself.  Example:
+-- 'Pinchot.Examples.Postal.rLetters'.
+
+nonTerminal
+  :: RuleName
+  -- ^ Will be used for the name of the resulting type
+  -> Seq (BranchName, Seq (Rule t))
+  -- ^ Branches of the non-terminal production rule.  This 'Seq'
+  -- must have at least one element; otherwise, an error will
+  -- result.
+  -> Rule t
+nonTerminal n branches = case Lens.uncons branches of
+  Nothing -> error $ "nonTerminal: rule has no branches: " ++ n
+  Just (b, bs) -> rule n (NonTerminal (f b) (fmap f bs))
+    where
+      f = uncurry Branch
+
+-- | Creates a non-terminal production rule where each branch has
+-- only one production.  This function ultimately uses
+-- 'nonTerminal'.  Each branch is assigned a 'BranchName' that is
+--
+-- @RULE_NAME'PRODUCTION_NAME@
+--
+-- where @RULE_NAME@ is the name of the rule itself, and
+-- @PRODUCTION_NAME@ is the rule name for what is being produced.
+--
+-- Example: 'Pinchot.Examples.Postal.rDirection'.
+union
+  :: RuleName
+  -- ^ Will be used for the name of the resulting type
+  -> Seq (Rule t)
+  -- ^ List of branches.  There must be at least one branch;
+  -- otherwise a compile-time error will occur.
+  -> Rule t
+union n rs = nonTerminal n (fmap f rs)
+  where
+    f rule@(Rule branchName _ _)
+      = (n ++ '\'' : branchName, Seq.singleton rule)
+
+-- | Creates a production for a sequence of terminals.  Useful for
+-- parsing specific words.  Ultimately this is simply a function
+-- that creates a 'Rule' using the 'record' function.
+--
+-- In @terminals n s@, For each 'Char' in the 'String', a 'Rule' is
+-- created whose 'RuleName' is @n@ followed by an apostrophe
+-- followed by the index of the position of the 'Char'.
+--
+-- Examples: 'Pinchot.Examples.Postal.rBoulevard'.
+
+terminals
+  :: RuleName
+  -- ^ Will be used for the name of the resulting type, and for the
+  -- name of the sole data constructor
+  -> String
+  -> Rule Char
+terminals n s = record n rules
+  where
+    rules = Seq.fromList . zipWith mkRule [(0 :: Int) ..] $ s
+    mkRule idx char = terminal nm (solo char)
+      where
+        nm = n ++ ('\'' : show idx)
+
+-- | Creates a newtype wrapper.  Example:
+-- 'Pinchot.Examples.Postal.rCity'.
+wrap
+  :: RuleName
+  -- ^ Will be used for the name of the resulting data type, and for
+  -- the name of the sole data constructor
+  -> Rule t
+  -- ^ The resulting 'Rule' simply wraps this 'Rule'.
+  -> Rule t
+wrap n r = rule n (Wrap r)
+
+
+-- | Creates a new non-terminal production rule with only one
+-- alternative where each field has a record name.  The name of each
+-- record is:
+--
+-- @_r\'RULE_NAME\'INDEX\'FIELD_TYPE@
+--
+-- where @RULE_NAME@ is the name of this rule, @INDEX@ is the index number
+-- for this field (starting with 0), and @FIELD_TYPE@ is the type of the
+-- field itself.
+--
+-- Currently there is no way to change the names of the record fields.
+--
+-- Example: 'Pinchot.Examples.Postal.rAddress'.
+record
+  :: RuleName
+  -- ^ The name of this rule, which is used both as the type name
+  -- and for the name of the sole data constructor
+
+  -> Seq (Rule t)
+  -- ^ The right-hand side of this rule.  This sequence can be empty,
+  -- which results in an epsilon production.
+  -> Rule t
+record n rs = rule n (Record rs)
+
+-- | Creates a rule for a production that optionally produces another
+-- rule.  The name for the created 'Rule' is the name of the 'Rule' to
+-- which this function is applied, with @'Opt@ appended to the end.
+--
+-- Example: 'Pinchot.Examples.Postal.rOptNewline'.
+opt
+  :: Rule t
+  -> Rule t
+opt r@(Rule innerNm _ _) = rule n (Opt r)
+  where
+    n = innerNm ++ "'Opt"
+
+-- | Creates a rule for the production of a sequence of other rules.
+-- The name for the created 'Rule' is the name of the 'Rule' to which
+-- this function is applied, with @'Star@ appended.
+--
+-- Example: 'Pinchot.Examples.Postal.rPreSpacedWord'.
+star
+  :: Rule t
+  -> Rule t
+star r@(Rule innerNm _ _) = rule (innerNm ++ "'Star") (Star r)
+
+-- | Creates a rule for a production that appears at least once.  The
+-- name for the created 'Rule' is the name of the 'Rule' to which this
+-- function is applied, with @'Plus@ appended.
+--
+-- Example: 'Pinchot.Examples.Postal.rDigits'.
+plus
+  :: Rule t
+  -> Rule t
+plus r@(Rule innerNm _ _) = rule (innerNm ++ "'Plus") (Plus r)
+
+-- | Gets all ancestor rules to this 'Rule'.  Includes the current
+-- rule if it has not already been seen.
+getAncestors :: Rule t -> State (Set RuleName) (Seq (Rule t))
+getAncestors r@(Rule name _ ty) = do
+  set <- get
+  if Set.member name set
+    then return Seq.empty
+    else do
+      put (Set.insert name set)
+      case ty of
+        Terminal _ -> return (Seq.singleton r)
+        NonTerminal b1 bs -> do
+          as1 <- branchAncestors b1
+          ass <- fmap join . traverse branchAncestors $ bs
+          return $ r <| as1 <> ass
+        Wrap c -> do
+          cs <- getAncestors c
+          return $ r <| cs
+        Record ls -> do
+          cs <- fmap join . traverse getAncestors $ ls
+          return $ r <| cs
+        Opt c -> do
+          cs <- getAncestors c
+          return $ r <| cs
+        Star c -> do
+          cs <- getAncestors c
+          return $ r <| cs
+        Plus c -> do
+          cs <- getAncestors c
+          return $ r <| cs
+  where
+    branchAncestors (Branch _ rs) = fmap join . traverse getAncestors $ rs
+
+-- | Gets all ancestor 'Rule's.  Includes the current 'Rule'.  Skips
+-- duplicates.
+family
+  :: Rule t
+  -> Seq (Rule t)
+family rule = State.evalState (getAncestors rule) Set.empty
+
+-- | Gets all the ancestor 'Rule's of a sequence of 'Rule'.  Includes
+-- each 'Rule' that is in the sequence.  Skips duplicates.
+families
+  :: Seq (Rule t)
+  -> Seq (Rule t)
+families
+  = join
+  . flip State.evalState Set.empty
+  . traverse getAncestors
diff --git a/lib/Pinchot/SyntaxTree.hs b/lib/Pinchot/SyntaxTree.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/SyntaxTree.hs
@@ -0,0 +1,113 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- | Grower - grows the types to hold a syntax tree
+
+module Pinchot.SyntaxTree where
+
+import Data.Foldable (toList)
+import Data.Sequence (Seq)
+import qualified Language.Haskell.TH as T
+
+import Pinchot.NonEmpty
+import Pinchot.Rules
+import Pinchot.Types
+
+-- | Makes the top-level declarations for each given 'Rule' and for
+-- all ancestors of the given 'Rule's.  Since ancestors are
+-- included, you can get the entire tree of types that you need by
+-- applying this function to a single start symbol.  Example:
+-- "Pinchot.Examples.SyntaxTrees".
+syntaxTrees
+  :: T.Name
+  -- ^ Name of terminal type.  Typically you will get this from the
+  -- Template Haskell quoting mechanism, e.g. @''Char@.
+  -> [T.Name]
+  -- ^ What to derive, e.g. @[''Eq, ''Ord, ''Show]@
+  -> Seq (Rule t)
+  -> T.DecsQ
+syntaxTrees term derives
+  = traverse (ruleToType term derives)
+  . toList
+  . families
+
+branchConstructor :: Branch t -> T.ConQ
+branchConstructor (Branch nm rules) = T.normalC name fields
+  where
+    name = T.mkName nm
+    mkField (Rule n _ _) = T.strictType T.notStrict
+      [t| $(T.conT (T.mkName n)) $(charTypeVar) $(anyTypeVar) |]
+    fields = toList . fmap mkField $ rules
+    anyTypeVar = T.varT (T.mkName "a")
+    charTypeVar = T.varT (T.mkName "t")
+
+-- | Makes the top-level declaration for a given rule.
+ruleToType
+  :: T.Name
+  -- ^ Name of terminal type
+  -> [T.Name]
+  -- ^ What to derive
+  -> Rule t
+  -> T.Q T.Dec
+ruleToType typeName derives (Rule nm _ ruleType) = case ruleType of
+  Terminal _ ->
+    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    where
+      newtypeCon = T.normalC name
+        [T.strictType T.notStrict
+          [t| ( $(charTypeVar), $(anyTypeVar) ) |] ]
+
+  NonTerminal b1 bs -> T.dataD (T.cxt []) name [charType, anyType] cons derives
+    where
+      cons = branchConstructor b1 : toList (fmap branchConstructor bs)
+
+  Wrap (Rule inner _ _) ->
+    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    where
+      newtypeCon = T.normalC name
+        [ T.strictType T.notStrict
+            [t| $(T.conT (T.mkName inner)) $(charTypeVar) $(anyTypeVar) |] ]
+
+  Record sq -> T.dataD (T.cxt []) name [charType, anyType] [ctor] derives
+    where
+      ctor = T.recC name . zipWith mkField [(0 :: Int) ..] . toList $ sq
+      mkField num (Rule rn _ _) = T.varStrictType (T.mkName fldNm)
+        (T.strictType T.notStrict
+          [t| $(T.conT (T.mkName rn)) $(charTypeVar) $(anyTypeVar) |])
+        where
+          fldNm = '_' : recordFieldName num nm rn
+
+  Opt (Rule inner _ _) ->
+    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    where
+      newtypeCon = T.normalC name
+        [T.strictType T.notStrict
+          [t| Maybe ( $(T.conT (T.mkName inner)) $(charTypeVar)
+                                                 $(anyTypeVar)) |]]
+
+  Star (Rule inner _ _) ->
+    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    where
+      newtypeCon = T.normalC name [sq]
+        where
+          sq = T.strictType T.notStrict
+            [t| Seq ( $(T.conT (T.mkName inner)) $(charTypeVar)
+                                                 $(anyTypeVar) ) |]
+
+  Plus (Rule inner _ _) ->
+    T.newtypeD (T.cxt []) name [charType, anyType] cons derives
+    where
+      cons = T.normalC name [ne]
+        where
+          ne = T.strictType T.notStrict [t| NonEmpty $(ins) |]
+            where
+              ins = [t| $(T.conT (T.mkName inner))
+                $(charTypeVar) $(anyTypeVar) |]
+
+  where
+    name = T.mkName nm
+    anyType = T.PlainTV (T.mkName "a")
+    anyTypeVar = T.varT (T.mkName "a")
+    charType = T.PlainTV (T.mkName "t")
+    charTypeVar = T.varT (T.mkName "t")
+
+
diff --git a/lib/Pinchot/SyntaxTree/Optics.hs b/lib/Pinchot/SyntaxTree/Optics.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/SyntaxTree/Optics.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Pinchot.SyntaxTree.Optics where
+
+import Data.Coerce (coerce)
+import Data.Foldable (toList)
+import Data.Maybe (catMaybes)
+import Data.Sequence (Seq)
+import qualified Control.Lens as Lens
+import qualified Language.Haskell.TH as T
+import qualified Language.Haskell.TH.Syntax as Syntax
+
+import Pinchot.Rules
+import Pinchot.Types
+import Pinchot.Intervals
+
+-- | Creates optics declarations for a 'Rule', if optics can
+-- be made for the 'Rule':
+--
+-- * 'Pinchot.terminal' gets a single 'Lens.Prism'
+--
+-- * 'Pinchot.nonTerminal' gets a 'Lens.Prism' for each constructor
+--
+-- * 'Pinchot.record' gets a single 'Lens.Lens'
+--
+-- * 'Pinchot.wrap', 'Pinchot.opt', 'Pinchot.star',
+-- and 'Pinchot.plus' do not get optics.
+--
+-- Each rule in the sequence of 'Rule', as well as all ancestors of
+-- those 'Rule's, will be handled.
+--
+-- Example: "Pinchot.Examples.RulesToOptics".
+rulesToOptics
+  :: Syntax.Lift t
+  => Qualifier
+  -- ^ Qualifier for module containing the data types that will get
+  -- optics
+  -> T.Name
+  -- ^ Type name for the terminal
+  -> Seq (Rule t)
+  -> T.Q [T.Dec]
+rulesToOptics qual termName
+  = fmap concat
+  . traverse (ruleToOptics qual termName)
+  . families
+
+-- | Creates optics declarations for a single 'Rule', if optics can
+-- be made for the 'Rule':
+--
+-- * 'Terminal' gets a single 'Lens.Prism'
+--
+-- * 'NonTerminal' gets a 'Lens.Prism' for each constructor
+--
+-- * 'Terminals' gets a single 'Lens.Prism'
+--
+-- * 'Record' gets a single 'Lens.Lens'
+--
+-- * 'Wrap', 'Opt', 'Star', and 'Plus' do not get optics.
+ruleToOptics
+  :: Syntax.Lift t
+  => Qualifier
+  -- ^ Qualifier for module containing the data type that will get
+  -- optics
+  -> T.Name
+  -- ^ Type name for the terminal
+  -> Rule t
+  -> T.Q [T.Dec]
+ruleToOptics qual termName (Rule nm _ ty) = case ty of
+  Terminal ivls -> terminalToOptics qual termName nm ivls
+  NonTerminal b1 bs -> sequence $ nonTerminalToOptics qual nm b1 bs
+  Record sq -> sequence $ recordsToOptics qual nm sq
+  _ -> return []
+  
+
+-- | Creates a prism for a terminal type.  Although a newtype wraps
+-- each terminal, do not make a Wrapped or an Iso, because the
+-- relationship between the outer type and the type that it wraps
+-- typically is not isometric.  Thus, use a Prism instead, which
+-- captures this relationship properly.
+terminalToOptics
+  :: Syntax.Lift t
+  => Qualifier
+  -- ^ Qualifier for module containing the data type that will get
+  -- optics
+  -> T.Name
+  -- ^ Terminal type name
+  -> String
+  -- ^ Rule name
+  -> Intervals t
+  -> T.Q [T.Dec]
+terminalToOptics qual termName nm ivls = do
+  e1 <- T.sigD (T.mkName ('_':nm))
+    $ T.forallT [ T.PlainTV (T.mkName "a")] (return [])
+    [t| Lens.Prism' ( $(T.conT termName), $(anyType) )
+                    ($(T.conT (quald qual nm)) $(T.conT termName) $(anyType))
+    |]
+  
+  e2 <- T.valD prismName (T.normalB expn) []
+  return [e1, e2]
+  where
+    anyType = T.varT (T.mkName "a")
+    charType = T.varT (T.mkName "t")
+    prismName = T.varP (T.mkName ('_' : nm))
+    fetchPat = T.conP (quald qual nm) [T.varP (T.mkName "_x")]
+    fetchName = T.varE (T.mkName "_x")
+    ctor = T.conE (quald qual nm)
+    expn = [| let fetch $fetchPat = $fetchName
+                  store (term, a)
+                    | inIntervals ivls term = Just ($(ctor) (term, a))
+                    | otherwise = Nothing
+              in Lens.prism' fetch store
+           |]
+
+-- | Creates prisms for each 'Branch'.
+nonTerminalToOptics
+  :: Qualifier
+  -- ^ Qualifier for module containing the data type that will get
+  -- optics
+  -> String
+  -- ^ Rule name
+  -> Branch t
+  -> Seq (Branch t)
+  -> [T.Q T.Dec]
+nonTerminalToOptics qual nm b1 bsSeq
+  = concat $ makePrism b1 : fmap makePrism bs
+  where
+    bs = toList bsSeq
+    makePrism (Branch inner rulesSeq) = [ signature, binding ]
+      where
+        charType = T.varT (T.mkName "t")
+        anyType = T.varT (T.mkName "a")
+        rules = toList rulesSeq
+        prismName = T.mkName ('_' : inner)
+        signature = T.sigD prismName
+          (forallA [t| Lens.Prism'
+              ($(T.conT (quald qual nm)) $(charType) $(anyType))
+              $(fieldsType) |])
+          where
+            fieldsType = case rules of
+              [] -> T.tupleT 0
+              Rule r1 _ _ : [] -> [t| $(T.conT (quald qual r1))
+                $(charType) $(anyType) |]
+              rs -> foldl addType (T.tupleT (length rs)) rs
+                where
+                  addType soFar (Rule r _ _) = soFar `T.appT`
+                    [t| $(T.conT (quald qual r)) $(charType) $(anyType) |]
+        binding = T.valD (T.varP prismName) body []
+          where
+            body = T.normalB
+              $ (T.varE 'Lens.prism)
+              `T.appE` setter
+              `T.appE` getter
+              where
+                setter = T.lamE [pat] expn
+                  where
+                    (pat, expn) = case rules of
+                      [] -> (T.tupP [], T.conE (quald qual inner))
+                      _ : [] -> (T.varP local,
+                        T.conE (quald qual inner)
+                        `T.appE` T.varE local)
+                        where
+                          local = T.mkName "_x"
+                      ls -> (T.tupP pats, set)
+                        where
+                          pats = fmap (\i -> T.varP (T.mkName ("_x" ++ show i)))
+                            . take (length ls) $ [(0 :: Int) ..]
+                          set = foldl addVar start . take (length ls)
+                            $ [(0 :: Int) ..]
+                            where
+                              addVar acc i = acc `T.appE`
+                                (T.varE (T.mkName ("_x" ++ show i)))
+                              start = T.conE (quald qual inner)
+
+                getter = T.lamE [pat] expn
+                  where
+                    local = T.mkName "_x"
+                    pat = T.varP local
+                    expn = T.caseE (T.varE (T.mkName "_x")) $
+                      T.match patCtor bodyCtor []
+                      : rest
+                      where
+                        patCtor = T.conP (quald qual inner)
+                          . fmap (\i -> T.varP (T.mkName $ "_y" ++ show i))
+                          . take (length rules)
+                          $ [(0 :: Int) ..]
+                        bodyCtor = T.normalB . (T.conE 'Right `T.appE`)
+                          $ case rules of
+                          [] -> T.tupE []
+                          _:[] -> T.varE (T.mkName "_y0")
+                          _ -> T.tupE
+                            . fmap (\i -> T.varE (T.mkName $ "_y" ++ show i))
+                            . take (length rules)
+                            $ [(0 :: Int) ..]
+                        rest = case bs of
+                          [] -> []
+                          _ -> [T.match patBlank bodyBlank []]
+                          where
+                            patBlank = T.varP (T.mkName "_z")
+                            bodyBlank = T.normalB
+                              $ T.conE ('Left)
+                              `T.appE` T.varE (T.mkName "_z")
+
+recordsToOptics
+  :: Qualifier
+  -- ^ Qualifier for module containing the data type that will get
+  -- optics
+  -> String
+  -- ^ Rule name
+  -> Seq (Rule t)
+  -> [T.Q T.Dec]
+recordsToOptics qual nm
+  = concat . zipWith makeLens [(0 :: Int) ..] . toList
+  where
+    makeLens index (Rule inner _ _) = [ signature, function ]
+      where
+        charType = T.varT (T.mkName "t")
+        anyType = T.varT (T.mkName "a")
+        fieldNm = recordFieldName index nm inner
+        lensName = T.mkName fieldNm
+        signature = T.sigD lensName (forallA
+          [t| Lens.Lens' ($(T.conT (quald qual nm)) $(charType) $(anyType))
+                         ($(T.conT (quald qual inner)) $(charType) $(anyType))
+          |])
+
+        function = T.funD lensName [T.clause [] (T.normalB body) []]
+          where
+            namedRec = T.mkName "_namedRec"
+            namedNewVal = T.mkName "_namedNewVal"
+            body = (T.varE 'Lens.lens) `T.appE` getter `T.appE` setter
+              where
+                getter = T.lamE [pat] expn
+                  where
+                    pat = T.varP namedRec
+                    expn = (T.varE (quald qual ('_' : fieldNm)))
+                      `T.appE` (T.varE namedRec)
+
+                setter = T.lamE [patRec, patNewVal] expn
+                  where
+                    patRec = T.varP namedRec
+                    patNewVal = T.varP namedNewVal
+                    expn = T.recUpdE (T.varE namedRec)
+                      [ return ( quald qual ('_' : fieldNm)
+                               , T.VarE namedNewVal) ]
+
+forallA :: T.TypeQ -> T.TypeQ
+forallA = T.forallT [ T.PlainTV (T.mkName "t")
+                    , T.PlainTV (T.mkName "a")] (return [])
diff --git a/lib/Pinchot/SyntaxTree/Wrappers.hs b/lib/Pinchot/SyntaxTree/Wrappers.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/SyntaxTree/Wrappers.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Pinchot.SyntaxTree.Wrappers where
+
+import Data.Foldable (toList)
+import Data.Maybe (catMaybes)
+import Data.Sequence (Seq)
+import qualified Control.Lens as Lens
+import qualified Language.Haskell.TH as T
+
+import Pinchot.NonEmpty
+import Pinchot.Rules
+import Pinchot.Types
+
+-- # Wrapped
+
+-- | Creates a 'Lens.Wrapped' instance for each 'Rule' and its
+-- ancestors, if there is an instance.
+-- Only 'Pinchot.terminal', 'Pinchot.wrap',
+-- 'Pinchot.opt', 'Pinchot.star', and 'Pinchot.plus'
+-- get instances of 'Lens.Wrapped'.
+--
+-- This must be
+-- spliced in the same module in which the syntax tree types are
+-- created; this way, no orphans are created.  Since ancestors are
+-- included, you can get the entire tree of types that you need by
+-- applying this function to a single start symbol.
+--
+-- Example: "Pinchot.Examples.SyntaxTrees".
+
+wrappedInstances
+  :: Seq (Rule t)
+  -> T.DecsQ
+wrappedInstances
+  = sequence
+  . catMaybes
+  . toList
+  . fmap singleWrappedInstance
+  . families
+
+-- | Creates a 'Lens.Wrapped' instance for the 'Rule', if there is
+-- one.  Only 'Pinchot.terminal', 'Pinchot.wrap',
+-- 'Pinchot.opt', 'Pinchot.star', and 'Pinchot.plus'
+-- get instances of 'Wrapped'.
+-- 'This must be spliced in the same module in which the
+-- syntax tree types are created.
+
+singleWrappedInstance
+  :: Rule t
+  -> Maybe (T.Q T.Dec)
+singleWrappedInstance (Rule nm _ ty) = case ty of
+  Terminal _ -> Just $ wrappedTerminal nm
+  Wrap (Rule inner _ _) -> Just $ wrappedWrap inner nm
+  Opt (Rule inner _ _) -> Just $ wrappedOpt inner nm
+  Star (Rule inner _ _) -> Just $ wrappedStar inner nm
+  Plus (Rule inner _ _) -> Just $ wrappedPlus inner nm
+  _ -> Nothing
+
+
+makeWrapped
+  :: T.TypeQ
+  -- ^ Name of wrapped type
+  -> String
+  -- ^ Name of wrapper type
+  -> T.Q T.Dec
+makeWrapped wrappedType nm = T.instanceD (return []) typ decs
+  where
+    name = T.mkName nm
+    local = T.mkName "_x"
+    typ = (T.conT ''Lens.Wrapped) `T.appT`
+      ((T.conT name)
+        `T.appT` (T.varT (T.mkName "t"))
+        `T.appT` (T.varT (T.mkName "a")))
+    decs = [assocType, wrapper]
+      where
+        assocType = T.tySynInstD ''Lens.Unwrapped
+          (T.tySynEqn [T.conT name
+            `T.appT` (T.varT (T.mkName "t"))
+            `T.appT` (T.varT (T.mkName "a"))]
+                      wrappedType)
+        wrapper = T.funD 'Lens._Wrapped'
+          [T.clause [] (T.normalB body) []]
+          where
+            body = (T.varE 'Lens.iso)
+              `T.appE` unwrap
+              `T.appE` doWrap
+              where
+                unwrap = T.lamE [lambPat] (T.varE local)
+                  where
+                    lambPat = T.conP name [T.varP local]
+                doWrap = T.lamE [lambPat] expn
+                  where
+                    expn = (T.conE name)
+                      `T.appE` (T.varE local)
+                    lambPat = T.varP local
+
+wrappedOpt
+  :: String
+  -- ^ Wrapped rule name
+  -> String
+  -- ^ Wrapping Rule name
+  -> T.Q T.Dec
+wrappedOpt wrappedName = makeWrapped maybeName
+  where
+    maybeName = (T.conT ''Maybe)
+      `T.appT`
+      ((T.conT (T.mkName wrappedName))
+        `T.appT` (T.varT (T.mkName "t"))
+        `T.appT` (T.varT (T.mkName "a")))
+
+wrappedTerminal
+  :: String
+  -- ^ Wrapper Rule name
+  -> T.Q T.Dec
+wrappedTerminal = makeWrapped
+  [t| ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")) ) |]
+
+wrappedTerminals
+  :: String
+  -- ^ Wrapper Rule name
+  -> T.Q T.Dec
+wrappedTerminals = makeWrapped
+  [t| Seq ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")) ) |]
+
+wrappedStar
+  :: String
+  -- ^ Wrapped rule name
+  -> String
+  -- ^ Wrapping Rule name
+  -> T.Q T.Dec
+wrappedStar wrappedName = makeWrapped innerName
+  where
+    innerName = (T.conT ''Seq) `T.appT`
+      ((T.conT (T.mkName wrappedName))
+        `T.appT` (T.varT (T.mkName "t"))
+        `T.appT` (T.varT (T.mkName "a")))
+
+wrappedPlus
+  :: String
+  -- ^ Wrapped rule name
+  -> String
+  -- ^ Wrapping Rule name
+  -> T.Q T.Dec
+wrappedPlus wrappedName = makeWrapped tupName
+  where
+    tupName = T.conT ''NonEmpty
+      `T.appT` ((T.conT (T.mkName wrappedName))
+                  `T.appT` (T.varT (T.mkName "t"))
+                  `T.appT` (T.varT (T.mkName "a")))
+
+wrappedWrap
+  :: String
+  -- ^ Wrapped rule name
+  -> String
+  -- ^ Wrapping Rule name
+  -> T.Q T.Dec
+wrappedWrap wrappedName = makeWrapped innerName
+  where
+    innerName =
+      ((T.conT (T.mkName wrappedName))
+        `T.appT` (T.varT (T.mkName "t"))
+        `T.appT` (T.varT (T.mkName "a")))
diff --git a/lib/Pinchot/Terminalize.hs b/lib/Pinchot/Terminalize.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Terminalize.hs
@@ -0,0 +1,323 @@
+{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Pinchot.Terminalize where
+
+import Control.Monad (join)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Data.Foldable (foldlM, toList)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Language.Haskell.TH as T
+import qualified Language.Haskell.TH.Syntax as Syntax
+
+import Pinchot.NonEmpty (NonEmpty(NonEmpty))
+import qualified Pinchot.NonEmpty as NonEmpty
+import Pinchot.Types
+import Pinchot.Rules
+
+-- | For all the given rules and their ancestors, creates
+-- declarations that reduce the rule and all its ancestors to
+-- terminal symbols.  Each rule gets a declaration named
+-- @t'RULE_NAME@ where @RULE_NAME@ is the name of the rule.  The
+-- type of the declaration is either
+--
+-- Production a -> Seq (t, a)
+--
+-- or
+--
+-- Production a -> NonEmpty (t, a)
+--
+-- where @Production@ is the production corresponding to the given
+-- 'Rule', @t@ is the terminal token type (often 'Char'), and @a@ is
+-- arbitrary metadata about each token (often 'Loc').  'NonEmpty' is
+-- returned for productions that must always contain at least one
+-- terminal symbol; for those that can be empty, 'Seq' is returned.
+--
+-- Example: "Pinchot.Examples.Terminalize".
+terminalizers
+  :: Qualifier
+  -- ^ Qualifier for the module containing the data types created
+  -- from the 'Rule's
+ 
+  -> T.Name
+  -- ^ Name of terminal type.  Typically you will get this through
+  -- the Template Haskell quoting mechanism, such as @''Char@.
+
+  -> Seq (Rule t)
+  -> T.Q [T.Dec]
+
+terminalizers qual termType
+  = fmap concat
+  . traverse (terminalizer qual termType)
+  . toList
+  . families
+
+-- | For the given rule, creates declarations that reduce the rule
+-- to terminal symbols.  No ancestors are handled.  Each rule gets a
+-- declaration named @t'RULE_NAME@ where @RULE_NAME@ is the name of
+-- the rule.  The
+-- type of the declaration is either
+--
+-- Production a -> Seq (t, a)
+--
+-- or
+--
+-- Production a -> NonEmpty (t, a)
+--
+-- where @Production@ is the production corresponding to the given
+-- 'Rule', @t@ is the terminal token type (often 'Char'), and @a@ is
+-- arbitrary metadata about each token (often 'Loc').  'NonEmpty' is
+-- returned for productions that must always contain at least one
+-- terminal symbol; for those that can be empty, 'Seq' is returned.
+
+terminalizer
+  :: Qualifier
+  -- ^ Qualifier for the module containing the data types created
+  -- from the 'Rule's
+ 
+  -> T.Name
+  -- ^ Name of terminal type.  Typically you will get this through
+  -- the Template Haskell quoting mechanism, such as @''Char@.
+
+  -> Rule t
+  -> T.Q [T.Dec]
+
+terminalizer qual termType rule@(Rule nm _ _) = sequence [sig, expn]
+  where
+    declName = "t'" ++ nm
+    anyType = T.varT (T.mkName "a")
+    charType = T.varT (T.mkName "t")
+    sig
+      | atLeastOne rule = T.sigD (T.mkName declName)
+          . T.forallT [T.PlainTV (T.mkName "t")
+                      , T.PlainTV (T.mkName "a")] (return [])
+          $ [t| $(T.conT (quald qual nm)) $(charType) $(anyType)
+            -> NonEmpty ($(charType), $(anyType)) |]
+      | otherwise = T.sigD (T.mkName declName)
+          . T.forallT [ T.PlainTV (T.mkName "t")
+                      , T.PlainTV (T.mkName "a")] (return [])
+          $ [t| $(T.conT (quald qual nm)) $(charType) $(anyType)
+              -> Seq ($(charType), $(anyType)) |]
+    expn = T.valD (T.varP $ T.mkName declName)
+      (T.normalB (terminalizeRuleExp qual rule)) []
+
+-- | For the given rule, returns an expression that has type of
+-- either
+--
+-- Production a -> Seq (t, a)
+--
+-- or
+--
+-- Production a -> NonEmpty (t, a)
+--
+-- where @Production@ is the production corresponding to the given
+-- 'Rule', and @t@ is the terminal token type.  'NonEmpty' is
+-- returned for productions that must always contain at least one
+-- terminal symbol; for those that can be empty, 'Seq' is returned.
+--
+-- Example:  'Pinchot.Examples.Terminalize.terminalizeAddress'.
+terminalizeRuleExp
+  :: Qualifier
+  -> Rule t
+  -> T.Q T.Exp
+terminalizeRuleExp qual rule@(Rule nm _ _) = do
+  let allRules = family rule 
+  lkp <- ruleLookupMap allRules
+  let mkDec r@(Rule rn _ _) =
+        let expn = terminalizeSingleRule qual lkp r
+            decName = lookupName lkp rn
+        in T.valD (T.varP decName) (T.normalB expn) []
+  T.letE (fmap mkDec . toList $ allRules) (T.varE (lookupName lkp nm))
+
+-- | Creates a 'Map' where each key is the name of the 'Rule' and
+-- each value is a name corresponding to that 'Rule'.  No
+-- ancestors are used.
+ruleLookupMap
+  :: Foldable c
+  => c (Rule t)
+  -> T.Q (Map RuleName (T.Name))
+ruleLookupMap = foldlM f Map.empty
+  where
+    f mp (Rule nm _ _) = do
+      name <- T.newName $ "rule" ++ nm
+      return $ Map.insert nm name mp
+
+lookupName
+  :: Map RuleName T.Name
+  -> RuleName
+  -> T.Name
+lookupName lkp n = case Map.lookup n lkp of
+  Nothing -> error $ "lookupName: name not found: " ++ n
+  Just r -> r
+
+-- | For the given rule, returns an expression that has type
+-- of either
+--
+-- Production a -> Seq (t, a)
+--
+-- or
+--
+-- Production a -> NonEmpty (t, a)
+--
+-- where @Production@ is the production corresponding to the given
+-- 'Rule', and @t@ is the terminal token type.  'NonEmpty' is
+-- returned for productions that must always contain at least one
+-- terminal symbol; for those that can be empty, 'Seq' is returned.
+-- Gets no ancestors.
+terminalizeSingleRule
+  :: Qualifier
+  -- ^ Module qualifier for module containing the generated types
+  -- corresponding to all 'Rule's
+  -> Map RuleName T.Name
+  -- ^ For a given Rule, looks up the name of the expression that
+  -- will terminalize that rule.
+  -> Rule t
+  -> T.Q T.Exp
+terminalizeSingleRule qual lkp rule@(Rule nm _ ty) = case ty of
+  Terminal _ -> do
+    x <- T.newName "x"
+    let pat = T.conP (quald qual nm) [T.varP x]
+    [| \ $(pat) -> NonEmpty.singleton $(T.varE x) |]
+
+  NonTerminal b1 bs -> do
+    x <- T.newName "x"
+    let fTzn | atLeastOne rule = terminalizeProductAtLeastOne
+             | otherwise = terminalizeProductAllowsZero
+        tzr (Branch name sq)
+          = fmap (\(pat, expn) -> T.match pat (T.normalB expn) [])
+          (fTzn qual lkp name sq)
+    m1 <- tzr b1
+    ms <- traverse tzr . toList $ bs
+    T.lamE [T.varP x] (T.caseE (T.varE x) (m1 : ms))
+
+  Wrap (Rule inner _ _) -> do
+    x <- T.newName "x"
+    let pat = T.conP (quald qual nm) [T.varP x]
+    [| \ $(pat) -> $(T.varE (lookupName lkp inner)) $(T.varE x) |]
+
+  Record rs -> do
+    (pat, expn) <- fTzr qual lkp nm rs
+    [| \ $(pat) -> $(expn) |]
+    where
+      fTzr | atLeastOne rule = terminalizeProductAtLeastOne
+           | otherwise = terminalizeProductAllowsZero
+
+  Opt r@(Rule inner _ _) -> do
+    x <- T.newName "x"
+    let pat = T.conP (quald qual nm) [T.varP x]
+    [| \ $(pat) -> maybe Seq.empty
+          $(convert (T.varE (lookupName lkp inner))) $(T.varE x) |]
+    where
+      convert expn | atLeastOne r = [| NonEmpty.flatten . $(expn) |]
+                   | otherwise = expn
+
+  Star r@(Rule inner _ _) -> do
+    x <- T.newName "x"
+    let pat = T.conP (quald qual nm) [T.varP x]
+        convert e | atLeastOne r = [| NonEmpty.flatten . $(e) |]
+                  | otherwise = e
+    [| \ $(pat) -> join . fmap $(convert (T.varE (lookupName lkp inner)))
+          $ $(T.varE x) |]
+
+  Plus r@(Rule inner _ _)
+    | atLeastOne r -> do
+        x <- T.newName "x"
+        let pat = T.conP (quald qual nm) [T.varP x]
+        [| \ $(pat) ->
+            let getTermNonEmpty = $(T.varE (lookupName lkp inner))
+                getTerms (NonEmpty e1 es) = join . fmap getTermNonEmpty
+                  $ NonEmpty.NonEmpty e1 es
+           in getTerms $(T.varE x)
+          |]
+
+    | otherwise -> do
+        x <- T.newName "x"
+        let pat = T.conP (quald qual nm) [T.varP x]
+        [| let getTermSeq = $(T.varE (lookupName lkp inner))
+               getTerms (NonEmpty e1 es) = getTermSeq e1
+                `mappend` (join (fmap getTermSeq es))
+           in getTerms $(T.varE x)
+          |]
+
+terminalizeProductAllowsZero
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> String
+  -- ^ Rule name or branch name, as applicable
+  -> Seq (Rule t)
+  -> T.Q (T.PatQ, T.ExpQ)
+terminalizeProductAllowsZero qual lkp name bs = do
+  pairs <- fmap toList . traverse (terminalizeProductRule lkp) $ bs
+  let pat = T.conP (quald qual name) (fmap (fst . snd) pairs)
+      body = case pairs of
+        [] -> [| Seq.empty |]
+        x:xs -> foldl f start xs
+          where
+            f acc trip = [| $(acc) `mappend` $(procTrip trip) |]
+            start = procTrip x
+            procTrip (rule, (_, expn))
+              | atLeastOne rule = [| NonEmpty.flatten $(expn) |]
+              | otherwise = expn
+  return (pat, body)
+
+terminalizeProductAtLeastOne
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> String
+  -- ^ Rule name or branch name, as applicable
+  -> Seq (Rule t)
+  -> T.Q (T.PatQ, T.ExpQ)
+terminalizeProductAtLeastOne qual lkp name bs = do
+  pairs <- fmap toList . traverse (terminalizeProductRule lkp) $ bs
+  let pat = T.conP (quald qual name) (fmap (fst . snd) pairs)
+      body = [| ( $(leadSeq) `NonEmpty.prependSeq` $(firstNonEmpty))
+                `NonEmpty.appendSeq` $(trailSeq) |]
+        where
+          (leadRules, lastRules) = span (not . atLeastOne . fst) pairs
+          (firstNonEmptyRule, trailRules) = case lastRules of
+            [] -> error $ "terminalizeProductAtLeastOne: failure 1: " ++ name
+            x:xs -> (x, xs)
+          leadSeq = case fmap (snd . snd) leadRules of
+            [] -> [| Seq.empty |]
+            x:xs -> foldl f x xs
+              where
+                f acc expn = [| $(acc) `mappend` $(expn) |]
+          firstNonEmpty = [| $(snd . snd $ firstNonEmptyRule) |]
+
+          trailSeq = foldl f [| Seq.empty |] trailRules
+            where
+              f acc (rule, (_, expn))
+                | atLeastOne rule =
+                    [| $(acc) `mappend` NonEmpty.flatten $(expn) |]
+                | otherwise =
+                    [| $(acc) `mappend` $(expn) |]
+  return (pat, body)
+
+terminalizeProductRule
+  :: Map RuleName T.Name
+  -> Rule t
+  -> T.Q (Rule t, (T.Q T.Pat, T.Q T.Exp))
+terminalizeProductRule lkp r@(Rule nm _ _) = do
+  x <- T.newName $ "terminalizeProductRule'" ++ nm
+  let getTerms = [| $(T.varE (lookupName lkp nm)) $(T.varE x) |]
+  return (r, (T.varP x, getTerms))
+
+-- | Examines a rule to determine whether when terminalizing it will
+-- always return at least one terminal symbol.
+atLeastOne
+  :: Rule t
+  -> Bool
+  -- ^ True if the rule will always have at least one terminal
+  -- symbol.
+atLeastOne (Rule _ _ ty) = case ty of
+  Terminal _ -> True
+  NonTerminal b1 bs -> branchAtLeastOne b1 && all branchAtLeastOne bs
+    where
+      branchAtLeastOne (Branch _ rs) = any atLeastOne rs
+  Wrap r -> atLeastOne r
+  Record rs -> any atLeastOne rs
+  Opt _ -> False
+  Star _ -> False
+  Plus r -> atLeastOne r
+
diff --git a/lib/Pinchot/Types.hs b/lib/Pinchot/Types.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Types.hs
@@ -0,0 +1,180 @@
+{-# OPTIONS_HADDOCK not-home #-}
+module Pinchot.Types where
+
+import Pinchot.Intervals
+
+import qualified Control.Lens as Lens
+import Data.Sequence (Seq)
+import qualified Language.Haskell.TH as T
+
+-- | Type synonym for the name of a production rule.  This will be the
+-- name of the type constructor for the corresponding type that will
+-- be created, so this must be a valid Haskell type constructor name.
+-- Typically each context-free grammar that you write will have
+-- several production rules; you will want to make sure that every
+-- 'RuleName' that you create for a single context-free grammar is
+-- unique.  However, Pinchot currently does not check for
+-- uniqueness.  If you use names that are not unique, GHC will give
+-- an error message when you try to splice the resulting code, as
+-- the data types will not have unique names.
+type RuleName = String
+
+-- | Type synonym the the name of an alternative in a 'nonTerminal'.
+-- This name must not conflict with any other data constructor in
+-- your grammar.
+type BranchName = String
+
+-- Rule n d t, where
+--
+-- n is the name of the rule.  This is used as the name of the
+-- corresponding data type.
+--
+-- d is the description of the rule.  This is optional and is used for
+-- the parser's error messages.  If there is no description, the name
+-- is used for error messages.
+--
+-- t is the type of rule (terminal, branch, etc.)
+
+-- | A single production rule.
+data Rule t = Rule
+  { _ruleName :: RuleName
+  , _ruleDescription :: Maybe String
+  , _ruleType :: RuleType t
+  } deriving (Eq, Ord, Show)
+
+-- Can't use Template Haskell in this module due to corecursive
+-- types
+
+ruleName :: Lens.Lens' (Rule t) RuleName
+ruleName
+  = Lens.lens _ruleName (\r n -> r { _ruleName = n })
+
+ruleDescription :: Lens.Lens' (Rule t) (Maybe String)
+ruleDescription
+  = Lens.lens _ruleDescription (\r d -> r { _ruleDescription = d })
+
+ruleType :: Lens.Lens' (Rule t) (RuleType t)
+ruleType
+  = Lens.lens _ruleType (\r t -> r { _ruleType = t })
+
+-- | A branch in a sum rule.  In @Branch s ls@, @s@ is the name of the
+-- data constructor, and @ls@ is the list of rules that this branch
+-- produces.
+data Branch t = Branch
+  { _branchName :: BranchName
+  , _branches :: Seq (Rule t)
+  } deriving (Eq, Ord, Show)
+
+branchName :: Lens.Lens' (Branch t) BranchName
+branchName
+  = Lens.lens _branchName (\b n -> b { _branchName = n })
+
+branches :: Lens.Lens' (Branch t) (Seq (Rule t))
+branches
+  = Lens.lens _branches (\b s -> b { _branches = s})
+
+-- | The type of a particular rule.
+data RuleType t
+  = Terminal (Intervals t)
+  | NonTerminal (Branch t) (Seq (Branch t))
+  | Wrap (Rule t)
+  | Record (Seq (Rule t))
+  | Opt (Rule t)
+  | Star (Rule t)
+  | Plus (Rule t)
+  deriving (Eq, Ord, Show)
+
+_Terminal :: Lens.Prism' (RuleType t) (Intervals t)
+_Terminal = Lens.prism' (\i -> Terminal i)
+  (\r -> case r of { Terminal i -> Just i; _ -> Nothing })
+
+_NonTerminal :: Lens.Prism' (RuleType t) (Branch t, Seq (Branch t))
+_NonTerminal = Lens.prism' (\(b, bs) -> NonTerminal b bs)
+  (\r -> case r of { NonTerminal b bs -> Just (b, bs); _ -> Nothing })
+
+_Wrap :: Lens.Prism' (RuleType t) (Rule t)
+_Wrap = Lens.prism' (\r -> Wrap r)
+  (\r -> case r of { Wrap x -> Just x; _ -> Nothing })
+
+_Record :: Lens.Prism' (RuleType t) (Seq (Rule t))
+_Record = Lens.prism' (\r -> Record r)
+  (\r -> case r of { Record x -> Just x; _ -> Nothing })
+
+_Opt :: Lens.Prism' (RuleType t) (Rule t)
+_Opt = Lens.prism' (\r -> Opt r)
+  (\r -> case r of { Opt x -> Just x; _ -> Nothing })
+
+_Star :: Lens.Prism' (RuleType t) (Rule t)
+_Star = Lens.prism' (\r -> Star r)
+  (\r -> case r of { Star x -> Just x; _ -> Nothing })
+
+_Plus :: Lens.Prism' (RuleType t) (Rule t)
+_Plus = Lens.prism' (\r -> Plus r)
+  (\r -> case r of { Plus x -> Just x; _ -> Nothing })
+
+-- | The name of a field in a record, without the leading
+-- underscore.
+recordFieldName
+  :: Int
+  -- ^ Index
+  -> String
+  -- ^ Parent type name
+  -> String
+  -- ^ Inner type name
+  -> String
+recordFieldName idx par inn = "r'" ++ par ++ "'" ++ show idx ++ "'" ++ inn
+
+-- | Many functions take an argument that holds the name qualifier
+-- for the module that contains the data types created by applying a
+-- function such as 'Pinchot.SyntaxTree.syntaxTrees' or
+-- 'Pinchot.Earley.earleyProduct'.
+--
+-- You will have to make sure that these data types are in scope.
+-- The spliced Template Haskell code has to know where to
+-- look for these data types.  If you did an unqualified @import@ or
+-- if the types are in the same module as the function that takes a
+-- 'Qualifier' argument, just pass the empty string here.  If you did a
+-- qualified import, use the appropriate qualifier here.
+--
+-- For example, if you used @import qualified MyAst@, pass
+-- @\"MyAst\"@ here.  If you used @import qualified
+-- Data.MyLibrary.MyAst as MyLibrary.MyAst@, pass
+-- @\"MyLibrary.MyAst\"@ here.
+--
+-- I recommend that you always create a new module and that all you
+-- do in that module is apply 'Pinchot.SyntaxTree.syntaxTrees' or
+-- 'Pinchot.Earley.earleyProduct', and that you then perform an @import
+-- qualified@ to bring those names into scope in the module in which
+-- you use a function that takes a 'Qualifier' argument.  This
+-- avoids unlikely, but possible, issues that could otherwise arise
+-- due to naming conflicts.
+type Qualifier = String
+
+
+-- | Prepends a qualifier to a string, and returns the resulting
+-- Name.
+quald
+  :: Qualifier
+  -> String
+  -- ^ Item to be named - constructor, value, etc.
+  -> T.Name
+quald qual suf
+  | null qual = T.mkName suf
+  | otherwise = T.mkName (qual ++ '.':suf)
+
+-- | A location.
+
+data Loc = Loc
+  { _line :: Int
+  , _col :: Int
+  , _pos :: Int
+  } deriving (Eq, Ord, Read, Show)
+
+line :: Lens.Lens' Loc Int
+line = Lens.lens _line (\r l -> r { _line = l })
+
+col :: Lens.Lens' Loc Int
+col = Lens.lens _col (\r l -> r { _col = l })
+
+pos :: Lens.Lens' Loc Int
+pos = Lens.lens _pos (\r l -> r { _pos = l })
diff --git a/pinchot.cabal b/pinchot.cabal
--- a/pinchot.cabal
+++ b/pinchot.cabal
@@ -3,11 +3,11 @@
 -- http://www.github.com/massysett/cartel
 --
 -- Script name used to generate: genCabal.hs
--- Generated on: 2016-03-04 16:15:31.455268 EST
+-- Generated on: 2016-04-10 09:37:56.35801 EDT
 -- Cartel library version: 0.14.2.8
 
 name: pinchot
-version: 0.14.0.0
+version: 0.16.0.0
 cabal-version: >= 1.14
 license: BSD3
 license-file: LICENSE
@@ -18,11 +18,10 @@
 stability: Experimental
 homepage: http://www.github.com/massysett/pinchot
 bug-reports: http://www.github.com/massysett/pinchot/issues
-synopsis: Build parsers and ASTs for context-free grammars
+synopsis: Write grammars, not parsers
 description:
   Pinchot provides a simple language that you use to write a Haskell
-  program that describes a context-free grammar.  When run, this program
-  creates a value representing the grammar.  Using this value, you can
+  value that describes a context-free grammar.  Using this value, you can
   automatically generate data types corresponding to the grammar,
   as well as an Earley parser to parse strings in that grammar.
   .
@@ -34,24 +33,33 @@
 Library
   exposed-modules:
     Pinchot
+    Pinchot.Earley
     Pinchot.Examples
-    Pinchot.Examples.AllEarleyGrammars
     Pinchot.Examples.AllRulesRecord
-    Pinchot.Examples.EarleyProduct
+    Pinchot.Examples.Earley
+    Pinchot.Examples.Newman
     Pinchot.Examples.Postal
-    Pinchot.Examples.PostalAstAllRules
-    Pinchot.Examples.PostalAstNoLenses
-    Pinchot.Examples.PostalAstRuleTree
-    Pinchot.Examples.QualifiedImport
-    Pinchot.Internal
+    Pinchot.Examples.RulesToOptics
+    Pinchot.Examples.SyntaxTrees
+    Pinchot.Examples.Terminalize
     Pinchot.Intervals
+    Pinchot.Locator
+    Pinchot.NonEmpty
+    Pinchot.RecursiveDo
+    Pinchot.Rules
+    Pinchot.SyntaxTree
+    Pinchot.SyntaxTree.Optics
+    Pinchot.SyntaxTree.Wrappers
+    Pinchot.Terminalize
+    Pinchot.Types
   build-depends:
       base >= 4.8.0.0 && < 5
     , containers >= 0.5.6.2
     , transformers >= 0.4.2.0
     , template-haskell >= 2.10
-    , Earley >= 0.10.1.0
+    , Earley >= 0.11.0.1
     , lens >= 4.13
+    , ListLike >= 4.2.1
   other-extensions:
     TemplateHaskell
   default-language: Haskell2010
@@ -62,126 +70,31 @@
   type: git
   location: https://github.com/massysett/penny.git
 
-Executable print-postal-grammar
-  main-is: print-postal-grammar.hs
+Executable newman
+  main-is: newman.hs
   if flag(executables)
     buildable: True
     other-modules:
       Pinchot
+      Pinchot.Earley
       Pinchot.Examples
-      Pinchot.Examples.AllEarleyGrammars
       Pinchot.Examples.AllRulesRecord
-      Pinchot.Examples.EarleyProduct
-      Pinchot.Examples.Postal
-      Pinchot.Examples.PostalAstAllRules
-      Pinchot.Examples.PostalAstNoLenses
-      Pinchot.Examples.PostalAstRuleTree
-      Pinchot.Examples.QualifiedImport
-      Pinchot.Internal
-      Pinchot.Intervals
-    hs-source-dirs:
-      exe
-    build-depends:
-        base >= 4.8.0.0 && < 5
-      , containers >= 0.5.6.2
-      , transformers >= 0.4.2.0
-      , template-haskell >= 2.10
-      , Earley >= 0.10.1.0
-      , lens >= 4.13
-    other-extensions:
-      TemplateHaskell
-    default-language: Haskell2010
-    hs-source-dirs:
-      lib
-  else
-    buildable: False
-
-Executable postal-parser
-  main-is: postal-parser.hs
-  if flag(executables)
-    buildable: True
-    other-modules:
-      Pinchot
-      Pinchot.Examples
-      Pinchot.Examples.AllEarleyGrammars
-      Pinchot.Examples.AllRulesRecord
-      Pinchot.Examples.EarleyProduct
-      Pinchot.Examples.Postal
-      Pinchot.Examples.PostalAstAllRules
-      Pinchot.Examples.PostalAstNoLenses
-      Pinchot.Examples.PostalAstRuleTree
-      Pinchot.Examples.QualifiedImport
-      Pinchot.Internal
-      Pinchot.Intervals
-    hs-source-dirs:
-      exe
-    build-depends:
-        pretty-show >= 1.6.9
-      , base >= 4.8.0.0 && < 5
-      , containers >= 0.5.6.2
-      , transformers >= 0.4.2.0
-      , template-haskell >= 2.10
-      , Earley >= 0.10.1.0
-      , lens >= 4.13
-    other-extensions:
-      TemplateHaskell
-    default-language: Haskell2010
-    hs-source-dirs:
-      lib
-  else
-    buildable: False
-
-Executable parrot
-  main-is: parrot.hs
-  if flag(executables)
-    buildable: True
-    other-modules:
-      Pinchot
-      Pinchot.Examples
-      Pinchot.Examples.AllEarleyGrammars
-      Pinchot.Examples.AllRulesRecord
-      Pinchot.Examples.EarleyProduct
-      Pinchot.Examples.Postal
-      Pinchot.Examples.PostalAstAllRules
-      Pinchot.Examples.PostalAstNoLenses
-      Pinchot.Examples.PostalAstRuleTree
-      Pinchot.Examples.QualifiedImport
-      Pinchot.Internal
-      Pinchot.Intervals
-    hs-source-dirs:
-      exe
-    build-depends:
-        base >= 4.8.0.0 && < 5
-      , containers >= 0.5.6.2
-      , transformers >= 0.4.2.0
-      , template-haskell >= 2.10
-      , Earley >= 0.10.1.0
-      , lens >= 4.13
-    other-extensions:
-      TemplateHaskell
-    default-language: Haskell2010
-    hs-source-dirs:
-      lib
-  else
-    buildable: False
-
-Executable parakeet
-  main-is: parakeet.hs
-  if flag(executables)
-    buildable: True
-    other-modules:
-      Pinchot
-      Pinchot.Examples
-      Pinchot.Examples.AllEarleyGrammars
-      Pinchot.Examples.AllRulesRecord
-      Pinchot.Examples.EarleyProduct
+      Pinchot.Examples.Earley
+      Pinchot.Examples.Newman
       Pinchot.Examples.Postal
-      Pinchot.Examples.PostalAstAllRules
-      Pinchot.Examples.PostalAstNoLenses
-      Pinchot.Examples.PostalAstRuleTree
-      Pinchot.Examples.QualifiedImport
-      Pinchot.Internal
+      Pinchot.Examples.RulesToOptics
+      Pinchot.Examples.SyntaxTrees
+      Pinchot.Examples.Terminalize
       Pinchot.Intervals
+      Pinchot.Locator
+      Pinchot.NonEmpty
+      Pinchot.RecursiveDo
+      Pinchot.Rules
+      Pinchot.SyntaxTree
+      Pinchot.SyntaxTree.Optics
+      Pinchot.SyntaxTree.Wrappers
+      Pinchot.Terminalize
+      Pinchot.Types
     hs-source-dirs:
       exe
     build-depends:
@@ -189,8 +102,9 @@
       , containers >= 0.5.6.2
       , transformers >= 0.4.2.0
       , template-haskell >= 2.10
-      , Earley >= 0.10.1.0
+      , Earley >= 0.11.0.1
       , lens >= 4.13
+      , ListLike >= 4.2.1
     other-extensions:
       TemplateHaskell
     default-language: Haskell2010