diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +## 0.3.0.0 (2021-03-03) +* `Reprinting m` is now `Reprinting i m`, where `i` is the input type, which + must be "`String`-like" (containers holding some "list" of `Char`s). + Previously, `i` was limited to `Text`. By default, `ByteString`, `Text` and + `String` are supported. +* Add an example module taking prompts from the 2017 paper, and rewrite the + tests to use the definitions in there. +* Support at least GHC 8.6, 8.8, 8.10, 9.0 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2017: Dominic Orchard, Vilem-Benjamin Liepelt, Harry Clarke + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/reprinter.cabal b/reprinter.cabal --- a/reprinter.cabal +++ b/reprinter.cabal @@ -1,19 +1,25 @@ --- This file has been generated from package.yaml by hpack version 0.17.1. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack +-- +-- hash: b19671665da6cf09b8aa157c387db536e02e3f8518551ed0fcfd6c5c43b40134 name: reprinter -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Scrap Your Reprinter description: A datatype generic algorithm for layout-preserving refactoring -license: Apache-2.0 -author: Dominic Orchard, Harry Clarke -maintainer: d.a.orchard@kent.ac.uk category: Text homepage: https://github.com/camfort/reprinter#readme bug-reports: https://github.com/camfort/reprinter/issues +author: Dominic Orchard, Vilem-Benjamin Liepelt, Harry Clarke +maintainer: d.a.orchard@kent.ac.uk +license: Apache-2.0 +license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 +extra-source-files: + CHANGELOG.md source-repository head type: git @@ -22,16 +28,36 @@ library exposed-modules: Text.Reprinter + Text.Reprinter.StringLike + Text.Reprinter.Example other-modules: Paths_reprinter + hs-source-dirs: + src build-depends: base >=4.9 && <5 + , bytestring >=0.10.8.0 && <0.12.0.0 + , mtl >=2.2 && <2.3 + , syb >=0.6 && <1.0 + , syz >=0.2 && <0.3 , text >=1.2.2 && <2 , transformers >=0.5 && <0.6 - , syb >=0.6 && <0.7 - , uniplate >=1.6 && <1.7 - , mtl >=2.2 && <2.3 - , syz ==0.2.0.0 + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Hspec.hs + other-modules: + ReprinterSpec + Paths_reprinter hs-source-dirs: - src + tests/hspec + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + base >=4.9 && <5 + , hspec + , mtl + , reprinter + , text default-language: Haskell2010 diff --git a/src/Text/Reprinter.hs b/src/Text/Reprinter.hs --- a/src/Text/Reprinter.hs +++ b/src/Text/Reprinter.hs @@ -2,37 +2,40 @@ {-# LANGUAGE DeriveDataTypeable #-} module Text.Reprinter - ( - reprintSort - , reprint - , Source + ( module Data.Functor.Identity + , module Data.Generics + , module Data.Generics.Zipper + , Span , Position , initPosition - , initLine , initCol - , mkLine + , initLine , mkCol - , advanceLine + , mkLine , advanceCol - , Span + , advanceLine + , RefactorType(..) + , Refactorable(..) , Reprinting , catchAll , genReprinting - , Refactorable(..) - , RefactorType(..) + , reprint + , reprintSort ) where +-- Import solely for re-exporting for library clients +import Data.Functor.Identity +import Data.Generics + + +import Text.Reprinter.StringLike import Control.Monad (forM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Lazy -import qualified Data.Text.Lazy as Text import Data.Data import Data.Generics.Zipper -import Data.Monoid ((<>), mempty) import Data.List (sortOn) - --- | Text from source file -type Source = Text.Text +import Data.Monoid ((<>), mempty) -- | A line within the source text newtype Line = Line Int deriving (Data, Eq, Ord, Show) @@ -79,7 +82,9 @@ type Span = (Position, Position) -- | Type of a reprinting function -type Reprinting m = forall node . Typeable node => node -> m (Maybe (RefactorType, Source, Span)) +-- +-- @i@ is the input type (something with a '[Char]'-like interface) +type Reprinting i m = forall node . (Typeable node) => node -> m (Maybe (RefactorType, i, Span)) -- | Specify a refactoring type data RefactorType = Before | After | Replace @@ -87,11 +92,11 @@ -- | The reprint algorithm takes a refactoring (parameteric in -- | some monad m) and turns an arbitrary pretty-printable type 'ast' --- | into a monadic Source transformer. -reprint :: (Monad m, Data ast) => Reprinting m -> ast -> Source -> m Source +-- | into a monadic 'StringLike i' transformer. +reprint :: (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i reprint reprinting ast input -- If the input is empty return empty - | Text.null input = return mempty + | slNull input = return mempty -- Otherwise proceed with the algorithm | otherwise = do @@ -103,8 +108,9 @@ -- Add to the output source the remaining input source return (out <> remaining) --- | Take a refactoring and a zipper producing a stateful Source transformer with Position state. -enter :: Monad m => Reprinting m -> Zipper ast -> StateT (Position, Source) m Source +-- | Take a refactoring and a zipper producing a stateful 'StringLike i' +-- | transformer with Position state. +enter :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> StateT (Position, i) m i enter reprinting zipper = do -- Step 1: Apply a refactoring refactoringInfo <- lift (query reprinting zipper) @@ -133,11 +139,11 @@ -- | The reprint algorithm takes a refactoring (parameteric in -- | some monad m) and turns an arbitrary pretty-printable type 'ast' --- | into a monadic Source transformer. -reprintSort :: (Monad m, Data ast) => Reprinting m -> ast -> Source -> m Source +-- | into a monadic 'StringLike i' transformer. +reprintSort :: (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i reprintSort reprinting ast input -- If the input is empty return empty - | Text.null input = return mempty + | slNull input = return mempty -- Otherwise proceed with the algorithm | otherwise = do @@ -151,19 +157,19 @@ -- | Take a refactoring and a zipper to produce a list of refactorings -enter' :: Monad m => Reprinting m -> Zipper ast - -> StateT (Position, Source) m Source +enter' :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast + -> StateT (Position, i) m i enter' reprinting zipper = do -- Step 1: Get refactorings via AST zipper traversal rs <- lift $ getRefactorings reprinting zipper [] -- Step 2: Do the splicing on the sorted refactorings srcs <- mapM splice (sortBySpan . reverse $ rs) - return $ Text.concat srcs + return $ mconcat srcs where sortBySpan = sortOn (\(_,_,sp) -> sp) -getRefactorings :: Monad m => Reprinting m -> Zipper ast -> [(RefactorType, Source, Span)] - -> m [(RefactorType, Source, Span)] +getRefactorings :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] + -> m [(RefactorType, i, Span)] getRefactorings reprinting zipper acc = do -- Step 1: Apply a refactoring refactoringInfo <- query reprinting zipper @@ -186,7 +192,7 @@ -- Otherwise return the empty string Nothing -> return acc -splice :: Monad m => (RefactorType, Source, Span) -> StateT (Position, Source) m Source +splice :: (Monad m, StringLike i) => (RefactorType, i, Span) -> StateT (Position, i) m i splice (typ, output, (lb, ub)) = do (cursor, inp) <- get case typ of @@ -210,25 +216,25 @@ put (ub, inp'') return (pre <> output <> post) --- Given a lower-bound and upper-bound pair of Positions, split the --- incoming Source based on the distance between the Position pairs -splitBySpan :: Span -> Source -> (Source, Source) +-- | Given a lower-bound and upper-bound pair of Positions, split the +-- | incoming 'StringLike i' based on the distance between the Position pairs. +splitBySpan :: StringLike i => Span -> i -> (i, i) splitBySpan (lower, upper) = subtext mempty lower where subtext acc cursor input | cursor < lower = - case Text.uncons input of + case slUncons input of Nothing -> done Just ('\n', input') -> subtext acc (advanceLine cursor) input' Just (_, input') -> subtext acc (advanceCol cursor) input' | cursor < upper = - case Text.uncons input of + case slUncons input of Nothing -> done - Just ('\n', input') -> subtext (Text.cons '\n' acc) (advanceLine cursor) input' - Just (x, input') -> subtext (Text.cons x acc) (advanceCol cursor) input' + Just ('\n', input') -> subtext (slCons '\n' acc) (advanceLine cursor) input' + Just (x, input') -> subtext (slCons x acc) (advanceCol cursor) input' | otherwise = done - where done = (Text.reverse acc, input) + where done = (slReverse acc, input) @@ -238,8 +244,8 @@ getSpan :: t -> Span -- | Essentially wraps the refactorable interface -genReprinting :: (Monad m, Refactorable t, Typeable t) - => (t -> m Source) -> t -> m (Maybe (RefactorType, Source, Span)) +genReprinting :: (Monad m, Refactorable t, Typeable t, StringLike i) + => (t -> m i) -> t -> m (Maybe (RefactorType, i, Span)) genReprinting f z = case isRefactored z of Nothing -> return Nothing Just refactorType -> do diff --git a/src/Text/Reprinter/Example.lhs b/src/Text/Reprinter/Example.lhs new file mode 100644 --- /dev/null +++ b/src/Text/Reprinter/Example.lhs @@ -0,0 +1,416 @@ +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 (Eq, Data, Typeable, 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 (Eq, Data, Typeable, 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 = "x = +(0,1)\n" +\end{code} + +We permit arbitrary spacing for prettier code, like so: + +\begin{code} +exPrettier :: String +exPrettier = unlines + [ "var = +(0 , 1)" + , "x = +(var, 2)" + ] +\end{code} + +And lines can be empty, or comments: + +\begin{code} +exComment :: String +exComment = unlines + [ "// slightly superfluous variable" + , "zero = 0" + , "" + , "// somewhat useful variable" + , "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 = unlines + [ "x = +(1,2)" + , "y = +(x,0)" + , "// Calculate z" + , "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 = map $ \(Decl a s n e) -> Decl a s n (go e) + where + go (Plus _ s e (Const _ _ 0)) = markRefactored (go e) s + go (Plus _ s (Const _ _ 0) e) = markRefactored (go e) s + go (Plus a s e1 e2) = Plus a s (go e1) (go e2) + go e = e + + markRefactored (Plus _ _ e1 e2) s = Plus True s e1 e2 + markRefactored (Var _ _ n) s = Var True s n + markRefactored (Const _ _ i) s = Const True s 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 (Plus True _ _ _) = Just Replace + isRefactored (Var True _ _) = Just Replace + isRefactored (Const True _ _) = Just Replace + isRefactored _ = Nothing + + getSpan (Plus _ s _ _) = s + getSpan (Var _ s _) = s + getSpan (Const _ s _) = 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 = catchAll `extQ` reprintExpr + where + reprintExpr x = genReprinting (return . prettyExpr) (x :: Expr Bool) + +-- | Print an expression in canonical string form. +prettyExpr :: Expr a -> String +prettyExpr (Plus _ _ e1 e2) = "+(" <> prettyExpr e1 <> ", " <> prettyExpr e2 <> ")" +prettyExpr (Var _ _ n) = n +prettyExpr (Const _ _ n) = show 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 s = + runIdentity + . flip (reprint exprReprinter) s + . refactorZero + . parse $ 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 = catchAll `extQ` decl + where + decl (Decl _ s v e) = do + val <- eval (e :: Expr Bool) + case val of + Nothing -> return $ Nothing -- declaration expression referenced a + -- variable before assignment: no annotation + Just val -> do + modify ((v,val) :) -- add mapping to environment + let msg = " // " <> v <> " = " <> show val + return $ Just (After, msg, s) + +eval :: Expr a -> State [(String, Int)] (Maybe Int) +eval (Plus _ _ e1 e2) = do + e1' <- eval e1 + e2' <- eval e2 + return $ (+) <$> e1' <*> e2' +eval (Const _ _ i) = return $ Just i +eval (Var _ _ s) = get >>= return . lookup s + +refactorComment :: String -> String +refactorComment input = + flip evalState [] + . flip (reprint commentPrinter) input + . parse $ 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 s = evalState parseDecl (s, initPosition) + +type Parser = State (String, Position) + +parseDecl :: Parser (AST Bool) +parseDecl = do + (xs, p1) <- get + case xs of + [] -> return [] + ('\n':xs) -> do + put (xs, advanceLine p1) + parseDecl + _ -> do + case commentPrefix xs of + Just (comment, rest) -> do + put (rest, p1) + parseDecl + Nothing -> do + name <- many isAlpha + spaces + char '=' + spaces + expr <- parseExpr + p2 <- getPos + char '\n' + (xs, p') <- get + put (xs, advanceLine p') + rest <- parseDecl + return $ Decl False (p1, p2) name expr : rest + +commentPrefix :: String -> Maybe (String, String) +commentPrefix [] = Nothing +commentPrefix (' ':xs) = commentPrefix xs +commentPrefix ('/':'/':xs) = Just $ break (== '\n') xs +commentPrefix _ = Nothing + +parseExpr :: Parser (Expr Bool) +parseExpr = do + p1 <- getPos + isPlus <- charP '+' + if isPlus then do + char '(' + spaces + n <- parseExpr + spaces + charP ',' + spaces + m <- parseExpr + spaces + char ')' + p2 <- getPos + return $ Plus False (p1, p2) n m + else do + isVar <- peekChar isAlpha + if isVar then do + name <- many isAlpha + p2 <- getPos + return $ Var False (p1, p2) name + else do + num <- many isDigit + p2 <- getPos + return $ Const False (p1, p2) $ read num + +-- Some monadic parser helpers (standard) + +getPos :: Parser Position +getPos = do + (_, p) <- get + return p + +many :: (Char -> Bool) -> Parser String +many p = do + (xs, pos) <- get + case xs of + (x:xs) | p x -> do + put (xs, advanceCol pos) + ys <- many p + return $ x : ys + _ -> return "" + +spaces = many (==' ') + +char :: Char -> Parser () +char c = do + (xs, pos) <- get + case xs of + (x:xs') -> if x == c + then do + put (xs', advanceCol pos) + return () + else error $ "Expecting " ++ [c] ++ " but got " ++ [x] + [] -> error $ "Expecting " ++ [c] ++ " but got empty" + +charP :: Char -> Parser Bool +charP c = do + (xs, pos) <- get + case xs of + (x:xs') -> if x == c + then do + put (xs', advanceCol pos) + return True + else return False + [] -> error $ "Expecting " ++ (c : " but got empty") + +peekChar :: (Char -> Bool) -> Parser Bool +peekChar p = do + (xs, pos) <- get + case xs of + (x:_) -> if p x + then return True + else return False +\end{code} diff --git a/src/Text/Reprinter/StringLike.hs b/src/Text/Reprinter/StringLike.hs new file mode 100644 --- /dev/null +++ b/src/Text/Reprinter/StringLike.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE TypeFamilies #-} + +module Text.Reprinter.StringLike + ( StringLike(..) + , IsString(..) + ) where + +import Data.List (uncons) +import Data.String (IsString(..)) + +import qualified Data.Text as TextStrict +import qualified Data.Text.Lazy as TextLazy +import qualified Data.ByteString.Char8 as BSCStrict +import qualified Data.ByteString.Lazy.Char8 as BSCLazy + +-- | Data types that can be used as a list-like structure of 'Char's. +-- +-- Clumsy solution to allow parameterising over the input type (Text, +-- ByteString, String), rather than converting to and from an internal concrete +-- type. Only operations required by the reprinting algorithm are included. +-- Where possible, operations are prefilled using presumed-existing instances +-- (any @[Char]@-like should be a monoid and have a @String -> a@). +class (Monoid a, IsString a) => StringLike a where + slCons :: Char -> a -> a + slUncons :: a -> Maybe (Char, a) + slNull :: a -> Bool + slReverse :: a -> a + -- | like @unpack@ + slToString :: a -> String + +-- same trick as used in IsString, to avoid possible ambiguity issues +instance (a ~ Char) => StringLike [a] where + slCons = (:) + slUncons = uncons + slNull = null + slReverse = reverse + slToString = id + +instance StringLike TextStrict.Text where + slCons = TextStrict.cons + slUncons = TextStrict.uncons + slNull = TextStrict.null + slReverse = TextStrict.reverse + slToString = TextStrict.unpack + +instance StringLike TextLazy.Text where + slCons = TextLazy.cons + slUncons = TextLazy.uncons + slNull = TextLazy.null + slReverse = TextLazy.reverse + slToString = TextLazy.unpack + +instance StringLike BSCStrict.ByteString where + slCons = BSCStrict.cons + slUncons = BSCStrict.uncons + slNull = BSCStrict.null + slReverse = BSCStrict.reverse + slToString = BSCStrict.unpack + +instance StringLike BSCLazy.ByteString where + slCons = BSCLazy.cons + slUncons = BSCLazy.uncons + slNull = BSCLazy.null + slReverse = BSCLazy.reverse + slToString = BSCLazy.unpack diff --git a/tests/hspec/Hspec.hs b/tests/hspec/Hspec.hs new file mode 100644 --- /dev/null +++ b/tests/hspec/Hspec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tests/hspec/ReprinterSpec.hs b/tests/hspec/ReprinterSpec.hs new file mode 100644 --- /dev/null +++ b/tests/hspec/ReprinterSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module ReprinterSpec where + +import Text.Reprinter +import Text.Reprinter.Example + +import Test.Hspec + +-- These tests use definitions from the example module 'Text.Reprinter.Example'. + +-- Note that 'unlines' appends a newline on to _every_ string, including the +-- last one. +spec :: Spec +spec = do + describe "refactor" $ do + it "removes additions of zeroes" $ do + refactor exPaper `shouldBe` unlines + [ "x = +(1,2)" + , "y = x" + , "// Calculate z" + , "z = +( 1, +(x ,y) )" + ] + it "removes additions of zeroes" $ do + refactor input_simple `shouldBe` "x = 1\n" + + describe "refactorComment" $ do + it "appends evaluated variables in comments" $ do + refactorComment exPaper `shouldBe` unlines + [ "x = +(1,2) // x = 3" + , "y = +(x,0) // y = 3" + , "// Calculate z" + , "z = +( 1, +(+(0,x) ,y) ) // z = 7" + ] + it "appends evaluated variables in comments" $ do + refactorComment input_simple `shouldBe` "x = +(1,0) // x = 1\n" + +input_simple :: String +input_simple = "x = +(1,0)\n" + +type AST' = AST Bool + +-- Apply zero-refactoring in a loop: deals with +(0, 0) subexpressions +refactorZeroLoop :: AST' -> AST' +refactorZeroLoop = refactorLoop refactorZero + +-- Apply the refactoring in a loop until a pass makes no changes. +refactorLoop :: (AST' -> AST') -> AST' -> AST' +refactorLoop refactoring ast + | refactoring ast == ast = ast + | otherwise = refactorLoop refactoring (refactoring ast)