Some Tokenize instances

src/Data/Syntax.hs

@@ -166,6 +166,9 @@ instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Identifier where
   eval (Identifier name) = pure (LvalLocal name)
 
+instance Tokenize Identifier where
+  tokenize = yield . Fragment . formatName . Data.Syntax.name
+
 instance FreeVariables1 Identifier where
   liftFreeVariables _ (Identifier x) = Set.singleton x
 
@@ -198,6 +201,9 @@ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
 instance Evaluatable Empty where
   eval _ = rvalBox unit
 
+instance Tokenize Empty where
+  tokenize = ignore
+
 -- | Syntax representing a parsing or assignment error.
 data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -299,3 +305,6 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Context where
   eval Context{..} = subtermRef contextSubject
+
+instance Tokenize Context where
+  tokenize Context{..} = for_ contextTerms (\c -> c *> yield Separator) *> contextSubject

src/Data/Syntax/Comment.hs

@@ -7,6 +7,7 @@ import Data.JSON.Fields
 import Diffing.Algorithm
 import Prologue
 import Proto3.Suite.Class
+import Reprinting.Tokenize as Token
 
 -- | An unnested comment (line or block).
 newtype Comment a = Comment { commentContent :: Text }
@@ -19,6 +20,9 @@ instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Comment where
   eval _ = rvalBox unit
 
+instance Tokenize Comment where
+  tokenize = yield . Fragment . commentContent
+
 -- TODO: nested comment types
 -- TODO: documentation comment types
 -- TODO: literate programming comment types? alternatively, consider those as markup

src/Data/Syntax/Literal.hs

@@ -51,6 +51,9 @@ instance Evaluatable Data.Syntax.Literal.Integer where
   eval (Data.Syntax.Literal.Integer x) =
     rvalBox =<< (integer <$> either (const (throwEvalError (IntegerFormatError x))) pure (parseInteger x))
 
+instance Tokenize Data.Syntax.Literal.Integer where
+  tokenize = yield . Fragment . integerContent
+
 -- | A literal float of unspecified width.
 
 newtype Float a = Float { floatContent :: Text }

src/Data/Syntax/Statement.hs

@@ -5,12 +5,14 @@ module Data.Syntax.Statement where
 import Data.Abstract.Evaluatable
 import Data.Aeson (ToJSON1 (..))
 import Data.JSON.Fields
+import Data.List (intersperse)
 import Data.Semigroup.App
 import Data.Semigroup.Foldable
 import Diffing.Algorithm
 import Prelude
 import Prologue
 import Proto3.Suite.Class
+import Reprinting.Tokenize
 
 -- | Imperative sequence of statements/declarations s.t.:
 --
@@ -28,6 +30,9 @@ instance ToJSON1 Statements
 instance Evaluatable Statements where
   eval (Statements xs) = maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
 
+instance Tokenize Statements where
+  tokenize = imperative_ . sep
+
 -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
 data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)