Export zipper

src/Text/Reprinter.hs

@@ -17,10 +17,12 @@ module Text.Reprinter
   , RefactorType(..)
   , Refactorable(..)
   , Reprinting
+  , ZipperReprinting
   , catchAll
   , genReprinting
   , reprint
   , reprintSort
+  , wrapBasicReprinter
   ) where
 
 -- Import solely for re-exporting for library clients
@@ -86,14 +88,20 @@ type Span = (Position, Position)
 -- @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))
 
+-- | Zipper reprinting allows reprinting functions to take into account context
+type ZipperReprinting i m = forall node . (Typeable node) => Zipper node -> m (Maybe (RefactorType, i, Span))
+
 -- | Specify a refactoring type
 data RefactorType = Before | After | Replace
     deriving Show -- for debugging
 
 -- | The reprint algorithm takes a refactoring (parameteric in
 -- | some monad m) and turns an arbitrary pretty-printable type 'ast'
 -- | into a monadic 'StringLike i' transformer.
-reprint :: (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i
+reprint
+    :: (Monad m, Data ast, StringLike i)
+    => ZipperReprinting i m -> ast -> i
+    -> m i
 reprint reprinting ast input
   -- If the input is empty return empty
   | slNull input = return mempty
@@ -110,10 +118,13 @@ reprint reprinting ast input
 
 -- | 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
+    :: (Monad m, StringLike i, Typeable ast)
+    => ZipperReprinting i m -> Zipper ast
+    -> StateT (Position, i) m i
 enter reprinting zipper = do
     -- Step 1: Apply a refactoring
-    refactoringInfo <- lift (query reprinting zipper)
+    refactoringInfo <- lift (reprinting zipper)
 
     -- Step 2: Deal with refactored code or go to children
     output <- case refactoringInfo of
@@ -138,9 +149,12 @@ enter reprinting zipper = do
 
 
 -- | The reprint algorithm takes a refactoring (parameteric in
--- | some monad m) and turns an arbitrary pretty-printable type 'ast'
--- | into a monadic 'StringLike i' transformer.
-reprintSort :: (Monad m, Data ast, StringLike i) => Reprinting i m -> ast -> i -> m i
+--   some monad m) and turns an arbitrary pretty-printable type 'ast'
+--   into a monadic 'StringLike i' transformer.
+reprintSort
+    :: (Monad m, Data ast, StringLike i)
+    => ZipperReprinting i m -> ast -> i
+    -> m i
 reprintSort reprinting ast input
   -- If the input is empty return empty
   | slNull input = return mempty
@@ -157,8 +171,10 @@ reprintSort reprinting ast input
 
 
 -- | Take a refactoring and a zipper to produce a list of refactorings
-enter' :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast
-      -> StateT (Position, i) m i
+enter'
+    :: (Monad m, StringLike i, Typeable ast)
+    => ZipperReprinting 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 []
@@ -168,11 +184,13 @@ enter' reprinting zipper = do
   where
     sortBySpan = sortOn (\(_,_,sp) -> sp)
 
-getRefactorings :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)]
-                    -> m [(RefactorType, i, Span)]
+getRefactorings
+    :: (Monad m, StringLike i, Typeable ast)
+    => ZipperReprinting 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
+    refactoringInfo <- reprinting zipper
     -- Step 2: Deal with refactored code or go to children
     acc <- case refactoringInfo of
       -- No refactoring; go to children
@@ -192,7 +210,10 @@ getRefactorings reprinting zipper acc = do
           -- Otherwise return the empty string
           Nothing -> return acc
 
-splice :: (Monad m, StringLike i) => (RefactorType, i, Span) -> StateT (Position, i) m i
+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
@@ -255,3 +276,9 @@ genReprinting f z = case isRefactored z of
 -- | Catch all generic query
 catchAll :: Monad m => a -> m (Maybe b)
 catchAll _ = return Nothing
+
+wrapBasicReprinter
+    :: (Monad m, StringLike i)
+    => Reprinting i m
+    -> ZipperReprinting i m
+wrapBasicReprinter = query

src/Text/Reprinter/Example.lhs

@@ -252,7 +252,7 @@ reprints.
 refactor :: String -> String
 refactor s =
       runIdentity
-    . flip (reprint exprReprinter) s
+    . flip (reprint (wrapBasicReprinter exprReprinter)) s
     . refactorZero
     . parse $ s
 
@@ -291,7 +291,7 @@ eval (Var _ _ s) = get >>= return . lookup s
 refactorComment :: String -> String
 refactorComment input =
       flip evalState []
-    . flip (reprint commentPrinter) input
+    . flip (reprint (wrapBasicReprinter commentPrinter)) input
     . parse $ input
 \end{code}
 

tests/hspec/ReprinterSpec.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module ReprinterSpec where