Scrap Your Reprinter: Example ============================= Reprinting takes a source file and its (possible transformed) AST and "stitches" them together into a new source file. This library provides a generic reprinting algorithm that works on any AST with some modest requirements. Where any changes to the AST have been made the reprinting algorithm can be parameterised to hook into application-specific functionality for handling nodes in the AST that have been marked as transformed (e.g., applying a pretty printer to these parts). This module gives an introduction to library usage. For a better view of the library itself, [the 2017 paper](https://www.cs.kent.ac.uk/people/staff/dao7/publ/reprinter2017.pdf) goes over implementation in depth. (This module is adapted from Section 3.4.) We demonstrate the library on a limited integer expression language (reused for the library tests). This is a literate Haskell/Markdown file, so feel free to follow along in GHCi or your favourite text viewer. \begin{code} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} module Text.Reprinter.Example where import Text.Reprinter import Control.Monad.State -- for later example import Data.Char -- for parsing \end{code} Introduction ------------ *(Section 1 of the 2017 paper covers this in better detail.)* A compiler translates source code to a target language. Sometimes when writing language tools, you may find yourself writing a compiler where the source and target languages are the same; automated code refactoring tools in IDEs provide a common set of examples. Such tools must be careful not to remove *secondary notation* like whitespace and comments. This, in short, can be a pain to do well. The reprinter library allows you to write a reprinter for any algebraic data type supporting a minimal interface the algorithm needs to track changes. This module designs a whitespace-flexible language with comments, and uses the library to allow reprinting that preserves such secondary notation. Language definition ------------------- Let's take a language targeting integer addition, plus variable assignments. Our top-level type will be an SSA-like list of *variable declaration-assignments*: \begin{code} type AST a = [Decl a] data Decl a = Decl a Span String (Expr a) deriving (Decl a -> Decl a -> Bool (Decl a -> Decl a -> Bool) -> (Decl a -> Decl a -> Bool) -> Eq (Decl a) forall a. Eq a => Decl a -> Decl a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Decl a -> Decl a -> Bool $c/= :: forall a. Eq a => Decl a -> Decl a -> Bool == :: Decl a -> Decl a -> Bool $c== :: forall a. Eq a => Decl a -> Decl a -> Bool Eq, Typeable (Decl a) DataType Constr Typeable (Decl a) -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a)) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a)) -> (Decl a -> Constr) -> (Decl a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Decl a))) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Decl a))) -> ((forall b. Data b => b -> b) -> Decl a -> Decl a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r) -> (forall u. (forall d. Data d => d -> u) -> Decl a -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> Decl a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a)) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a)) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a)) -> Data (Decl a) Decl a -> DataType Decl a -> Constr (forall d. Data d => c (t d)) -> Maybe (c (Decl a)) (forall b. Data b => b -> b) -> Decl a -> Decl a (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a) (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a) forall a. Data a => Typeable (Decl a) forall a. Data a => Decl a -> DataType forall a. Data a => Decl a -> Constr forall a. Data a => (forall b. Data b => b -> b) -> Decl a -> Decl a forall a u. Data a => Int -> (forall d. Data d => d -> u) -> Decl a -> u forall a u. Data a => (forall d. Data d => d -> u) -> Decl a -> [u] forall a r r'. Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r forall a r r'. Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r forall a (m :: * -> *). (Data a, Monad m) => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) forall a (c :: * -> *). Data a => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a) forall a (c :: * -> *). Data a => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a) forall a (t :: * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d. Data d => c (t d)) -> Maybe (c (Decl a)) forall a (t :: * -> * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Decl a)) forall a. Typeable a -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a) -> (a -> Constr) -> (a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)) -> ((forall b. Data b => b -> b) -> a -> a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall u. (forall d. Data d => d -> u) -> a -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> Data a forall u. Int -> (forall d. Data d => d -> u) -> Decl a -> u forall u. (forall d. Data d => d -> u) -> Decl a -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a) forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a) forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Decl a)) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Decl a)) $cDecl :: Constr $tDecl :: DataType gmapMo :: (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) $cgmapMo :: forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) gmapMp :: (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) $cgmapMp :: forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) gmapM :: (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) $cgmapM :: forall a (m :: * -> *). (Data a, Monad m) => (forall d. Data d => d -> m d) -> Decl a -> m (Decl a) gmapQi :: Int -> (forall d. Data d => d -> u) -> Decl a -> u $cgmapQi :: forall a u. Data a => Int -> (forall d. Data d => d -> u) -> Decl a -> u gmapQ :: (forall d. Data d => d -> u) -> Decl a -> [u] $cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Decl a -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r $cgmapQr :: forall a r r'. Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r $cgmapQl :: forall a r r'. Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Decl a -> r gmapT :: (forall b. Data b => b -> b) -> Decl a -> Decl a $cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Decl a -> Decl a dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Decl a)) $cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Decl a)) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Decl a)) $cdataCast1 :: forall a (t :: * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d. Data d => c (t d)) -> Maybe (c (Decl a)) dataTypeOf :: Decl a -> DataType $cdataTypeOf :: forall a. Data a => Decl a -> DataType toConstr :: Decl a -> Constr $ctoConstr :: forall a. Data a => Decl a -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a) $cgunfold :: forall a (c :: * -> *). Data a => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Decl a) gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a) $cgfoldl :: forall a (c :: * -> *). Data a => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Decl a -> c (Decl a) $cp1Data :: forall a. Data a => Typeable (Decl a) Data, Typeable, Int -> Decl a -> ShowS [Decl a] -> ShowS Decl a -> String (Int -> Decl a -> ShowS) -> (Decl a -> String) -> ([Decl a] -> ShowS) -> Show (Decl a) forall a. Show a => Int -> Decl a -> ShowS forall a. Show a => [Decl a] -> ShowS forall a. Show a => Decl a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Decl a] -> ShowS $cshowList :: forall a. Show a => [Decl a] -> ShowS show :: Decl a -> String $cshow :: forall a. Show a => Decl a -> String showsPrec :: Int -> Decl a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Decl a -> ShowS Show) \end{code} A `Decl a span var expr` represents the assignment of the value of an expression `expr` to a variable `var`. The AST is composed of a sequence (list) of these `Decl`s. Expressions are formed of variables, literals, and additions over expressions: \begin{code} data Expr a = Plus a Span (Expr a) (Expr a) | Var a Span String | Const a Span Int deriving (Expr a -> Expr a -> Bool (Expr a -> Expr a -> Bool) -> (Expr a -> Expr a -> Bool) -> Eq (Expr a) forall a. Eq a => Expr a -> Expr a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Expr a -> Expr a -> Bool $c/= :: forall a. Eq a => Expr a -> Expr a -> Bool == :: Expr a -> Expr a -> Bool $c== :: forall a. Eq a => Expr a -> Expr a -> Bool Eq, Typeable (Expr a) DataType Constr Typeable (Expr a) -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a)) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a)) -> (Expr a -> Constr) -> (Expr a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Expr a))) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr a))) -> ((forall b. Data b => b -> b) -> Expr a -> Expr a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r) -> (forall u. (forall d. Data d => d -> u) -> Expr a -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> Expr a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a)) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a)) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a)) -> Data (Expr a) Expr a -> DataType Expr a -> Constr (forall d. Data d => c (t d)) -> Maybe (c (Expr a)) (forall b. Data b => b -> b) -> Expr a -> Expr a (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a) (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a) forall a. Data a => Typeable (Expr a) forall a. Data a => Expr a -> DataType forall a. Data a => Expr a -> Constr forall a. Data a => (forall b. Data b => b -> b) -> Expr a -> Expr a forall a u. Data a => Int -> (forall d. Data d => d -> u) -> Expr a -> u forall a u. Data a => (forall d. Data d => d -> u) -> Expr a -> [u] forall a r r'. Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r forall a r r'. Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r forall a (m :: * -> *). (Data a, Monad m) => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) forall a (c :: * -> *). Data a => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a) forall a (c :: * -> *). Data a => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a) forall a (t :: * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d. Data d => c (t d)) -> Maybe (c (Expr a)) forall a (t :: * -> * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr a)) forall a. Typeable a -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a) -> (a -> Constr) -> (a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)) -> ((forall b. Data b => b -> b) -> a -> a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall u. (forall d. Data d => d -> u) -> a -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> Data a forall u. Int -> (forall d. Data d => d -> u) -> Expr a -> u forall u. (forall d. Data d => d -> u) -> Expr a -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a) forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a) forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Expr a)) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr a)) $cConst :: Constr $cVar :: Constr $cPlus :: Constr $tExpr :: DataType gmapMo :: (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) $cgmapMo :: forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) gmapMp :: (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) $cgmapMp :: forall a (m :: * -> *). (Data a, MonadPlus m) => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) gmapM :: (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) $cgmapM :: forall a (m :: * -> *). (Data a, Monad m) => (forall d. Data d => d -> m d) -> Expr a -> m (Expr a) gmapQi :: Int -> (forall d. Data d => d -> u) -> Expr a -> u $cgmapQi :: forall a u. Data a => Int -> (forall d. Data d => d -> u) -> Expr a -> u gmapQ :: (forall d. Data d => d -> u) -> Expr a -> [u] $cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Expr a -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r $cgmapQr :: forall a r r'. Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r $cgmapQl :: forall a r r'. Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr a -> r gmapT :: (forall b. Data b => b -> b) -> Expr a -> Expr a $cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Expr a -> Expr a dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr a)) $cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr a)) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Expr a)) $cdataCast1 :: forall a (t :: * -> *) (c :: * -> *). (Data a, Typeable t) => (forall d. Data d => c (t d)) -> Maybe (c (Expr a)) dataTypeOf :: Expr a -> DataType $cdataTypeOf :: forall a. Data a => Expr a -> DataType toConstr :: Expr a -> Constr $ctoConstr :: forall a. Data a => Expr a -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a) $cgunfold :: forall a (c :: * -> *). Data a => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Expr a) gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a) $cgfoldl :: forall a (c :: * -> *). Data a => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Expr a -> c (Expr a) $cp1Data :: forall a. Data a => Typeable (Expr a) Data, Typeable, Int -> Expr a -> ShowS [Expr a] -> ShowS Expr a -> String (Int -> Expr a -> ShowS) -> (Expr a -> String) -> ([Expr a] -> ShowS) -> Show (Expr a) forall a. Show a => Int -> Expr a -> ShowS forall a. Show a => [Expr a] -> ShowS forall a. Show a => Expr a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Expr a] -> ShowS $cshowList :: forall a. Show a => [Expr a] -> ShowS show :: Expr a -> String $cshow :: forall a. Show a => Expr a -> String showsPrec :: Int -> Expr a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Expr a -> ShowS Show) \end{code} For our reprinting algorithm, every refactorable node in the AST must store position information (`Span`, i.e., the start and end point of this piece of syntax in the source code text) and whether it's been refactored (and thus needs reprinting). In this case, we've parameterised our AST over an arbitrary type `a`, which we specialise in the rest of this file to `Bool` to represent whether this node has been refactored or not. In a more complex AST, you could add this as a field to an existing node annotation record type. Note that the algorithm requires ASTs to have `Data` and `Typeable` instances. Deriving these automatically requires the `DeriveDataTypeable` language pragma. *(Section 1.1 in the 2017 paper gives an illustrated step-by-step example of a transformation and reprint.)* Concrete syntax and goals ------------------------- Let's digress for a while to discuss our language's concrete syntax, since reprinting uses abstract and concrete syntax simultaneously. Our language is going to look something like this: \begin{code} exBasic :: String exBasic :: String exBasic = String "x = +(0,1)\n" \end{code} We permit arbitrary spacing for prettier code, like so: \begin{code} exPrettier :: String exPrettier :: String exPrettier = [String] -> String unlines [ String "var = +(0 , 1)" , String "x = +(var, 2)" ] \end{code} And lines can be empty, or comments: \begin{code} exComment :: String exComment :: String exComment = [String] -> String unlines [ String "// slightly superfluous variable" , String "zero = 0" , String "" , String "// somewhat useful variable" , String "x = +(zero, 1)" ] \end{code} Knowing all this, our aim is to take a formatted program source, parse it, apply a transformation to the AST, then reprint the program while keeping the original formatting. Starting with the given source (taken from the 2017 paper) \begin{code} exPaper :: String exPaper :: String exPaper = [String] -> String unlines [ String "x = +(1,2)" , String "y = +(x,0)" , String "// Calculate z" , String "z = +( 1, +(+(0,x) ,y) )" ] \end{code} We'll produce the following refactored and reprinted output: > putStr exPaper x = +(1,2) y = +(x,0) // Calculate z z = +( 1, +(+(0,x) ,y) ) > (putStr . refactor) exPaper x = +(1,2) y = x // Calculate z z = +( 1, +(x ,y) ) Writing a transformation ------------------------ Putting concrete syntax aside, let's write a transformation for our AST - a refactoring. A nice obvious one is replacing `x+0` (and `0+x`) expressions with just `x`. \begin{code} refactorZero :: AST Bool -> AST Bool refactorZero :: AST Bool -> AST Bool refactorZero = (Decl Bool -> Decl Bool) -> AST Bool -> AST Bool forall a b. (a -> b) -> [a] -> [b] map ((Decl Bool -> Decl Bool) -> AST Bool -> AST Bool) -> (Decl Bool -> Decl Bool) -> AST Bool -> AST Bool forall a b. (a -> b) -> a -> b $ \(Decl Bool a Span s String n Expr Bool e) -> Bool -> Span -> String -> Expr Bool -> Decl Bool forall a. a -> Span -> String -> Expr a -> Decl a Decl Bool a Span s String n (Expr Bool -> Expr Bool go Expr Bool e) where go :: Expr Bool -> Expr Bool go (Plus Bool _ Span s Expr Bool e (Const Bool _ Span _ Int 0)) = Expr Bool -> Span -> Expr Bool markRefactored (Expr Bool -> Expr Bool go Expr Bool e) Span s go (Plus Bool _ Span s (Const Bool _ Span _ Int 0) Expr Bool e) = Expr Bool -> Span -> Expr Bool markRefactored (Expr Bool -> Expr Bool go Expr Bool e) Span s go (Plus Bool a Span s Expr Bool e1 Expr Bool e2) = Bool -> Span -> Expr Bool -> Expr Bool -> Expr Bool forall a. a -> Span -> Expr a -> Expr a -> Expr a Plus Bool a Span s (Expr Bool -> Expr Bool go Expr Bool e1) (Expr Bool -> Expr Bool go Expr Bool e2) go Expr Bool e = Expr Bool e markRefactored :: Expr Bool -> Span -> Expr Bool markRefactored (Plus Bool _ Span _ Expr Bool e1 Expr Bool e2) Span s = Bool -> Span -> Expr Bool -> Expr Bool -> Expr Bool forall a. a -> Span -> Expr a -> Expr a -> Expr a Plus Bool True Span s Expr Bool e1 Expr Bool e2 markRefactored (Var Bool _ Span _ String n) Span s = Bool -> Span -> String -> Expr Bool forall a. a -> Span -> String -> Expr a Var Bool True Span s String n markRefactored (Const Bool _ Span _ Int i) Span s = Bool -> Span -> Int -> Expr Bool forall a. a -> Span -> Int -> Expr a Const Bool True Span s Int i \end{code} Note that when marking nodes as refactored (`markRefactored`), we replace the `Span` of the refactored node with the span of the original `x+0` node- this allows the reprinting algorithm to replace the original part of the source code with the new refactored node. In concrete syntax, we're making changes like: + ( x , 0 ) becomes x See how `x` is pulled out. The `+(x,y)` expression is directly replaced with `x`, so we make sure to use the original span. Any comments following the expression will be `shifted' - *not* removed, because the reprinter only makes changes when a node in the AST indicates it has been refactored. Parts of a source file that aren't captured in the AST will be printed with no changes. Reprinter plumbing ------------------ We have an AST and a transformation on it. Next, we need to tell the reprinter how to use our AST. \begin{code} -- FlexibleInstances used to define this without a wrapper instance Refactorable (Expr Bool) where isRefactored :: Expr Bool -> Maybe RefactorType isRefactored (Plus Bool True Span _ Expr Bool _ Expr Bool _) = RefactorType -> Maybe RefactorType forall a. a -> Maybe a Just RefactorType Replace isRefactored (Var Bool True Span _ String _) = RefactorType -> Maybe RefactorType forall a. a -> Maybe a Just RefactorType Replace isRefactored (Const Bool True Span _ Int _) = RefactorType -> Maybe RefactorType forall a. a -> Maybe a Just RefactorType Replace isRefactored Expr Bool _ = Maybe RefactorType forall a. Maybe a Nothing getSpan :: Expr Bool -> Span getSpan (Plus Bool _ Span s Expr Bool _ Expr Bool _) = Span s getSpan (Var Bool _ Span s String _) = Span s getSpan (Const Bool _ Span s Int _) = Span s \end{code} Your AST's `Refactorable` instances will depend on how you store annotations in your tree. Likely you store refactoring information inside a larger record type. Perhaps you disallow refactoring at the type level for certain nodes. In this case, we're only writing an instance for `Expr`s, because we don't reprint `Decl`s directly. (If we wrote a variable renaming transformation, then it would be needed.) We're almost there. Next we define a generic query over the AST that determines what we do for each node in the AST. This reprinting is straightforward: * If an `Expr` is marked as refactored, replace it with the updated `Expr` pretty-printed (AST -> concrete syntax) * Else skip (if the node was a `Decl`, or an unrefactored `Expr`) Reprintings of this type can be generated with `genReprinting`. A later example writes the reprinting directly to annotate all nodes of a certain type. For now, let's code that reprinting and the required pretty printer: \begin{code} -- See the 2017 paper and SYB documentation for more info on 'extQ' queries. exprReprinter :: Reprinting String Identity exprReprinter :: node -> Identity (Maybe (RefactorType, String, Span)) exprReprinter = node -> Identity (Maybe (RefactorType, String, Span)) forall (m :: * -> *) a b. Monad m => a -> m (Maybe b) catchAll (node -> Identity (Maybe (RefactorType, String, Span))) -> (Expr Bool -> Identity (Maybe (RefactorType, String, Span))) -> node -> Identity (Maybe (RefactorType, String, Span)) forall a b q. (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q `extQ` Expr Bool -> Identity (Maybe (RefactorType, String, Span)) forall (m :: * -> *). Monad m => Expr Bool -> m (Maybe (RefactorType, String, Span)) reprintExpr where reprintExpr :: Expr Bool -> m (Maybe (RefactorType, String, Span)) reprintExpr Expr Bool x = (Expr Bool -> m String) -> Expr Bool -> m (Maybe (RefactorType, String, Span)) forall (m :: * -> *) t i. (Monad m, Refactorable t, Typeable t, StringLike i) => (t -> m i) -> t -> m (Maybe (RefactorType, i, Span)) genReprinting (String -> m String forall (m :: * -> *) a. Monad m => a -> m a return (String -> m String) -> (Expr Bool -> String) -> Expr Bool -> m String forall b c a. (b -> c) -> (a -> b) -> a -> c . Expr Bool -> String forall a. Expr a -> String prettyExpr) (Expr Bool x :: Expr Bool) -- | Print an expression in canonical string form. prettyExpr :: Expr a -> String prettyExpr :: Expr a -> String prettyExpr (Plus a _ Span _ Expr a e1 Expr a e2) = String "+(" String -> ShowS forall a. Semigroup a => a -> a -> a <> Expr a -> String forall a. Expr a -> String prettyExpr Expr a e1 String -> ShowS forall a. Semigroup a => a -> a -> a <> String ", " String -> ShowS forall a. Semigroup a => a -> a -> a <> Expr a -> String forall a. Expr a -> String prettyExpr Expr a e2 String -> ShowS forall a. Semigroup a => a -> a -> a <> String ")" prettyExpr (Var a _ Span _ String n) = String n prettyExpr (Const a _ Span _ Int n) = Int -> String forall a. Show a => a -> String show Int n -- Note that we don't define a pretty printer for declarations, as we're not -- refactoring on that level, so won't ever reprint them. \end{code} `catchAll \`extQ\` reprintExpr` essentially says "try casting my argument to use in `reprintExpr`, else default to `catchAll`" where `catchAll` always returns `Nothing` (meaning no refactoring/don't reprint). See the 2017 paper and Scrap Your Boilerplate (SYB) materials for more details. Finally, we put together a function that parses, runs our refactoring, then reprints. \begin{code} -- | Parse and refactor, then run the reprinter with the original source and -- updated AST. refactor :: String -> String refactor :: ShowS refactor String s = Identity String -> String forall a. Identity a -> a runIdentity (Identity String -> String) -> (String -> Identity String) -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . (AST Bool -> String -> Identity String) -> String -> AST Bool -> Identity String forall a b c. (a -> b -> c) -> b -> a -> c flip (Reprinting String Identity -> AST Bool -> String -> Identity String forall (m :: * -> *) ast i. (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i reprint Reprinting String Identity exprReprinter) String s (AST Bool -> Identity String) -> (String -> AST Bool) -> String -> Identity String forall b c a. (b -> c) -> (a -> b) -> a -> c . AST Bool -> AST Bool refactorZero (AST Bool -> AST Bool) -> (String -> AST Bool) -> String -> AST Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> AST Bool parse ShowS -> ShowS forall a b. (a -> b) -> a -> b $ String s \end{code} Further example: reprinting `After` ----------------------------------- Using a monadic reprinter, we can write more complex reprintings. This example from the 2017 paper annotates every variable declaration with its value. Declarations are evaluated in order, building up a variable-value association list. The list is stored in the `State` monad, which is passed along through the reprinting. \begin{code} commentPrinter :: Reprinting String (State [(String, Int)]) commentPrinter :: node -> State [(String, Int)] (Maybe (RefactorType, String, Span)) commentPrinter = node -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall (m :: * -> *) a b. Monad m => a -> m (Maybe b) catchAll (node -> State [(String, Int)] (Maybe (RefactorType, String, Span))) -> (Decl Bool -> State [(String, Int)] (Maybe (RefactorType, String, Span))) -> node -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall a b q. (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q `extQ` Decl Bool -> State [(String, Int)] (Maybe (RefactorType, String, Span)) decl where decl :: Decl Bool -> State [(String, Int)] (Maybe (RefactorType, String, Span)) decl (Decl Bool _ Span s String v Expr Bool e) = do Maybe Int val <- Expr Bool -> State [(String, Int)] (Maybe Int) forall a. Expr a -> State [(String, Int)] (Maybe Int) eval (Expr Bool e :: Expr Bool) case Maybe Int val of Maybe Int Nothing -> Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span))) -> Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall a b. (a -> b) -> a -> b $ Maybe (RefactorType, String, Span) forall a. Maybe a Nothing -- declaration expression referenced a -- variable before assignment: no annotation Just Int val -> do ([(String, Int)] -> [(String, Int)]) -> StateT [(String, Int)] Identity () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((String v,Int val) (String, Int) -> [(String, Int)] -> [(String, Int)] forall a. a -> [a] -> [a] :) -- add mapping to environment let msg :: String msg = String " // " String -> ShowS forall a. Semigroup a => a -> a -> a <> String v String -> ShowS forall a. Semigroup a => a -> a -> a <> String " = " String -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int val Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span))) -> Maybe (RefactorType, String, Span) -> State [(String, Int)] (Maybe (RefactorType, String, Span)) forall a b. (a -> b) -> a -> b $ (RefactorType, String, Span) -> Maybe (RefactorType, String, Span) forall a. a -> Maybe a Just (RefactorType After, String msg, Span s) eval :: Expr a -> State [(String, Int)] (Maybe Int) eval :: Expr a -> State [(String, Int)] (Maybe Int) eval (Plus a _ Span _ Expr a e1 Expr a e2) = do Maybe Int e1' <- Expr a -> State [(String, Int)] (Maybe Int) forall a. Expr a -> State [(String, Int)] (Maybe Int) eval Expr a e1 Maybe Int e2' <- Expr a -> State [(String, Int)] (Maybe Int) forall a. Expr a -> State [(String, Int)] (Maybe Int) eval Expr a e2 Maybe Int -> State [(String, Int)] (Maybe Int) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Int -> State [(String, Int)] (Maybe Int)) -> Maybe Int -> State [(String, Int)] (Maybe Int) forall a b. (a -> b) -> a -> b $ Int -> Int -> Int forall a. Num a => a -> a -> a (+) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe Int e1' Maybe (Int -> Int) -> Maybe Int -> Maybe Int forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Maybe Int e2' eval (Const a _ Span _ Int i) = Maybe Int -> State [(String, Int)] (Maybe Int) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Int -> State [(String, Int)] (Maybe Int)) -> Maybe Int -> State [(String, Int)] (Maybe Int) forall a b. (a -> b) -> a -> b $ Int -> Maybe Int forall a. a -> Maybe a Just Int i eval (Var a _ Span _ String s) = StateT [(String, Int)] Identity [(String, Int)] forall s (m :: * -> *). MonadState s m => m s get StateT [(String, Int)] Identity [(String, Int)] -> ([(String, Int)] -> State [(String, Int)] (Maybe Int)) -> State [(String, Int)] (Maybe Int) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Maybe Int -> State [(String, Int)] (Maybe Int) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Int -> State [(String, Int)] (Maybe Int)) -> ([(String, Int)] -> Maybe Int) -> [(String, Int)] -> State [(String, Int)] (Maybe Int) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [(String, Int)] -> Maybe Int forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup String s refactorComment :: String -> String refactorComment :: ShowS refactorComment String input = (State [(String, Int)] String -> [(String, Int)] -> String) -> [(String, Int)] -> State [(String, Int)] String -> String forall a b c. (a -> b -> c) -> b -> a -> c flip State [(String, Int)] String -> [(String, Int)] -> String forall s a. State s a -> s -> a evalState [] (State [(String, Int)] String -> String) -> (String -> State [(String, Int)] String) -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . (AST Bool -> String -> State [(String, Int)] String) -> String -> AST Bool -> State [(String, Int)] String forall a b c. (a -> b -> c) -> b -> a -> c flip (Reprinting String (StateT [(String, Int)] Identity) -> AST Bool -> String -> State [(String, Int)] String forall (m :: * -> *) ast i. (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i reprint Reprinting String (StateT [(String, Int)] Identity) commentPrinter) String input (AST Bool -> State [(String, Int)] String) -> (String -> AST Bool) -> String -> State [(String, Int)] String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> AST Bool parse ShowS -> ShowS forall a b. (a -> b) -> a -> b $ String input \end{code} Unscrapped boilerplate: parser for example language --------------------------------------------------- The remainder of this module defines a simple monadic parser for the language. It attempts to generate a position-tagged AST from a `String`. \begin{code} parse :: String -> AST Bool parse :: String -> AST Bool parse String s = State (String, Position) (AST Bool) -> (String, Position) -> AST Bool forall s a. State s a -> s -> a evalState State (String, Position) (AST Bool) parseDecl (String s, Position initPosition) type Parser = State (String, Position) parseDecl :: Parser (AST Bool) parseDecl :: State (String, Position) (AST Bool) parseDecl = do (String xs, Position p1) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get case String xs of [] -> AST Bool -> State (String, Position) (AST Bool) forall (m :: * -> *) a. Monad m => a -> m a return [] (Char '\n':String xs) -> do (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String xs, Position -> Position advanceLine Position p1) State (String, Position) (AST Bool) parseDecl String _ -> do case String -> Maybe (String, String) commentPrefix String xs of Just (String comment, String rest) -> do (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String rest, Position p1) State (String, Position) (AST Bool) parseDecl Maybe (String, String) Nothing -> do String name <- (Char -> Bool) -> Parser String many Char -> Bool isAlpha Parser String spaces Char -> StateT (String, Position) Identity () char Char '=' Parser String spaces Expr Bool expr <- Parser (Expr Bool) parseExpr Position p2 <- Parser Position getPos Char -> StateT (String, Position) Identity () char Char '\n' (String xs, Position p') <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String xs, Position -> Position advanceLine Position p') AST Bool rest <- State (String, Position) (AST Bool) parseDecl AST Bool -> State (String, Position) (AST Bool) forall (m :: * -> *) a. Monad m => a -> m a return (AST Bool -> State (String, Position) (AST Bool)) -> AST Bool -> State (String, Position) (AST Bool) forall a b. (a -> b) -> a -> b $ Bool -> Span -> String -> Expr Bool -> Decl Bool forall a. a -> Span -> String -> Expr a -> Decl a Decl Bool False (Position p1, Position p2) String name Expr Bool expr Decl Bool -> AST Bool -> AST Bool forall a. a -> [a] -> [a] : AST Bool rest commentPrefix :: String -> Maybe (String, String) commentPrefix :: String -> Maybe (String, String) commentPrefix [] = Maybe (String, String) forall a. Maybe a Nothing commentPrefix (Char ' ':String xs) = String -> Maybe (String, String) commentPrefix String xs commentPrefix (Char '/':Char '/':String xs) = (String, String) -> Maybe (String, String) forall a. a -> Maybe a Just ((String, String) -> Maybe (String, String)) -> (String, String) -> Maybe (String, String) forall a b. (a -> b) -> a -> b $ (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n') String xs commentPrefix String _ = Maybe (String, String) forall a. Maybe a Nothing parseExpr :: Parser (Expr Bool) parseExpr :: Parser (Expr Bool) parseExpr = do Position p1 <- Parser Position getPos Bool isPlus <- Char -> Parser Bool charP Char '+' if Bool isPlus then do Char -> StateT (String, Position) Identity () char Char '(' Parser String spaces Expr Bool n <- Parser (Expr Bool) parseExpr Parser String spaces Char -> Parser Bool charP Char ',' Parser String spaces Expr Bool m <- Parser (Expr Bool) parseExpr Parser String spaces Char -> StateT (String, Position) Identity () char Char ')' Position p2 <- Parser Position getPos Expr Bool -> Parser (Expr Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Expr Bool -> Parser (Expr Bool)) -> Expr Bool -> Parser (Expr Bool) forall a b. (a -> b) -> a -> b $ Bool -> Span -> Expr Bool -> Expr Bool -> Expr Bool forall a. a -> Span -> Expr a -> Expr a -> Expr a Plus Bool False (Position p1, Position p2) Expr Bool n Expr Bool m else do Bool isVar <- (Char -> Bool) -> Parser Bool peekChar Char -> Bool isAlpha if Bool isVar then do String name <- (Char -> Bool) -> Parser String many Char -> Bool isAlpha Position p2 <- Parser Position getPos Expr Bool -> Parser (Expr Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Expr Bool -> Parser (Expr Bool)) -> Expr Bool -> Parser (Expr Bool) forall a b. (a -> b) -> a -> b $ Bool -> Span -> String -> Expr Bool forall a. a -> Span -> String -> Expr a Var Bool False (Position p1, Position p2) String name else do String num <- (Char -> Bool) -> Parser String many Char -> Bool isDigit Position p2 <- Parser Position getPos Expr Bool -> Parser (Expr Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Expr Bool -> Parser (Expr Bool)) -> Expr Bool -> Parser (Expr Bool) forall a b. (a -> b) -> a -> b $ Bool -> Span -> Int -> Expr Bool forall a. a -> Span -> Int -> Expr a Const Bool False (Position p1, Position p2) (Int -> Expr Bool) -> Int -> Expr Bool forall a b. (a -> b) -> a -> b $ String -> Int forall a. Read a => String -> a read String num -- Some monadic parser helpers (standard) getPos :: Parser Position getPos :: Parser Position getPos = do (String _, Position p) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get Position -> Parser Position forall (m :: * -> *) a. Monad m => a -> m a return Position p many :: (Char -> Bool) -> Parser String many :: (Char -> Bool) -> Parser String many Char -> Bool p = do (String xs, Position pos) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get case String xs of (Char x:String xs) | Char -> Bool p Char x -> do (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String xs, Position -> Position advanceCol Position pos) String ys <- (Char -> Bool) -> Parser String many Char -> Bool p String -> Parser String forall (m :: * -> *) a. Monad m => a -> m a return (String -> Parser String) -> String -> Parser String forall a b. (a -> b) -> a -> b $ Char x Char -> ShowS forall a. a -> [a] -> [a] : String ys String _ -> String -> Parser String forall (m :: * -> *) a. Monad m => a -> m a return String "" spaces :: Parser String spaces = (Char -> Bool) -> Parser String many (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool ==Char ' ') char :: Char -> Parser () char :: Char -> StateT (String, Position) Identity () char Char c = do (String xs, Position pos) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get case String xs of (Char x:String xs') -> if Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char c then do (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String xs', Position -> Position advanceCol Position pos) () -> StateT (String, Position) Identity () forall (m :: * -> *) a. Monad m => a -> m a return () else String -> StateT (String, Position) Identity () forall a. HasCallStack => String -> a error (String -> StateT (String, Position) Identity ()) -> String -> StateT (String, Position) Identity () forall a b. (a -> b) -> a -> b $ String "Expecting " String -> ShowS forall a. [a] -> [a] -> [a] ++ [Char c] String -> ShowS forall a. [a] -> [a] -> [a] ++ String " but got " String -> ShowS forall a. [a] -> [a] -> [a] ++ [Char x] [] -> String -> StateT (String, Position) Identity () forall a. HasCallStack => String -> a error (String -> StateT (String, Position) Identity ()) -> String -> StateT (String, Position) Identity () forall a b. (a -> b) -> a -> b $ String "Expecting " String -> ShowS forall a. [a] -> [a] -> [a] ++ [Char c] String -> ShowS forall a. [a] -> [a] -> [a] ++ String " but got empty" charP :: Char -> Parser Bool charP :: Char -> Parser Bool charP Char c = do (String xs, Position pos) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get case String xs of (Char x:String xs') -> if Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char c then do (String, Position) -> StateT (String, Position) Identity () forall s (m :: * -> *). MonadState s m => s -> m () put (String xs', Position -> Position advanceCol Position pos) Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True else Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False [] -> String -> Parser Bool forall a. HasCallStack => String -> a error (String -> Parser Bool) -> String -> Parser Bool forall a b. (a -> b) -> a -> b $ String "Expecting " String -> ShowS forall a. [a] -> [a] -> [a] ++ (Char c Char -> ShowS forall a. a -> [a] -> [a] : String " but got empty") peekChar :: (Char -> Bool) -> Parser Bool peekChar :: (Char -> Bool) -> Parser Bool peekChar Char -> Bool p = do (String xs, Position pos) <- StateT (String, Position) Identity (String, Position) forall s (m :: * -> *). MonadState s m => m s get case String xs of (Char x:String _) -> if Char -> Bool p Char x then Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True else Bool -> Parser Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False \end{code}