{-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-} module Text.Reprinter ( module Data.Functor.Identity , module Data.Generics , module Data.Generics.Zipper , Span , Position , initPosition , initCol , initLine , mkCol , mkLine , advanceCol , advanceLine , RefactorType(..) , Refactorable(..) , Reprinting , catchAll , genReprinting , 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 Data.Data import Data.Generics.Zipper import Data.List (sortOn) import Data.Monoid ((<>), mempty) -- | A line within the source text newtype Line = Line Int deriving (Typeable Line DataType Constr Typeable Line -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Line -> c Line) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Line) -> (Line -> Constr) -> (Line -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Line)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line)) -> ((forall b. Data b => b -> b) -> Line -> Line) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r) -> (forall u. (forall d. Data d => d -> u) -> Line -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> Line -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Line -> m Line) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Line -> m Line) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Line -> m Line) -> Data Line Line -> DataType Line -> Constr (forall b. Data b => b -> b) -> Line -> Line (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Line -> c Line (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Line 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) -> Line -> u forall u. (forall d. Data d => d -> u) -> Line -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Line -> m Line forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Line -> m Line forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Line forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Line -> c Line forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Line) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line) $cLine :: Constr $tLine :: DataType gmapMo :: (forall d. Data d => d -> m d) -> Line -> m Line $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Line -> m Line gmapMp :: (forall d. Data d => d -> m d) -> Line -> m Line $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Line -> m Line gmapM :: (forall d. Data d => d -> m d) -> Line -> m Line $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Line -> m Line gmapQi :: Int -> (forall d. Data d => d -> u) -> Line -> u $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Line -> u gmapQ :: (forall d. Data d => d -> u) -> Line -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Line -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r gmapT :: (forall b. Data b => b -> b) -> Line -> Line $cgmapT :: (forall b. Data b => b -> b) -> Line -> Line dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Line) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Line) dataTypeOf :: Line -> DataType $cdataTypeOf :: Line -> DataType toConstr :: Line -> Constr $ctoConstr :: Line -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Line $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Line gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Line -> c Line $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Line -> c Line $cp1Data :: Typeable Line Data, Line -> Line -> Bool (Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Line -> Line -> Bool $c/= :: Line -> Line -> Bool == :: Line -> Line -> Bool $c== :: Line -> Line -> Bool Eq, Eq Line Eq Line -> (Line -> Line -> Ordering) -> (Line -> Line -> Bool) -> (Line -> Line -> Bool) -> (Line -> Line -> Bool) -> (Line -> Line -> Bool) -> (Line -> Line -> Line) -> (Line -> Line -> Line) -> Ord Line Line -> Line -> Bool Line -> Line -> Ordering Line -> Line -> Line forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Line -> Line -> Line $cmin :: Line -> Line -> Line max :: Line -> Line -> Line $cmax :: Line -> Line -> Line >= :: Line -> Line -> Bool $c>= :: Line -> Line -> Bool > :: Line -> Line -> Bool $c> :: Line -> Line -> Bool <= :: Line -> Line -> Bool $c<= :: Line -> Line -> Bool < :: Line -> Line -> Bool $c< :: Line -> Line -> Bool compare :: Line -> Line -> Ordering $ccompare :: Line -> Line -> Ordering $cp1Ord :: Eq Line Ord, Int -> Line -> ShowS [Line] -> ShowS Line -> String (Int -> Line -> ShowS) -> (Line -> String) -> ([Line] -> ShowS) -> Show Line forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Line] -> ShowS $cshowList :: [Line] -> ShowS show :: Line -> String $cshow :: Line -> String showsPrec :: Int -> Line -> ShowS $cshowsPrec :: Int -> Line -> ShowS Show) -- | Lines start at 1 initLine :: Line initLine :: Line initLine = Int -> Line Line Int 1 -- | Smart constructor for a Line, checks that line >= 1 mkLine :: Int -> Either String Line mkLine :: Int -> Either String Line mkLine Int l | Int l Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 1 = String -> Either String Line forall a b. a -> Either a b Left (String -> Either String Line) -> String -> Either String Line forall a b. (a -> b) -> a -> b $ String "mkLine: called with: " String -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int l String -> ShowS forall a. Semigroup a => a -> a -> a <> String ". Minimum is 1." | Bool otherwise = Line -> Either String Line forall a b. b -> Either a b Right (Int -> Line Line Int l) -- | A column within the source text newtype Col = Col Int deriving (Typeable Col DataType Constr Typeable Col -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Col -> c Col) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Col) -> (Col -> Constr) -> (Col -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Col)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Col)) -> ((forall b. Data b => b -> b) -> Col -> Col) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r) -> (forall u. (forall d. Data d => d -> u) -> Col -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> Col -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Col -> m Col) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Col -> m Col) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Col -> m Col) -> Data Col Col -> DataType Col -> Constr (forall b. Data b => b -> b) -> Col -> Col (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Col -> c Col (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Col 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) -> Col -> u forall u. (forall d. Data d => d -> u) -> Col -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Col -> m Col forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Col -> m Col forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Col forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Col -> c Col forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Col) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Col) $cCol :: Constr $tCol :: DataType gmapMo :: (forall d. Data d => d -> m d) -> Col -> m Col $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Col -> m Col gmapMp :: (forall d. Data d => d -> m d) -> Col -> m Col $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Col -> m Col gmapM :: (forall d. Data d => d -> m d) -> Col -> m Col $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Col -> m Col gmapQi :: Int -> (forall d. Data d => d -> u) -> Col -> u $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Col -> u gmapQ :: (forall d. Data d => d -> u) -> Col -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Col -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Col -> r gmapT :: (forall b. Data b => b -> b) -> Col -> Col $cgmapT :: (forall b. Data b => b -> b) -> Col -> Col dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Col) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Col) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Col) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Col) dataTypeOf :: Col -> DataType $cdataTypeOf :: Col -> DataType toConstr :: Col -> Constr $ctoConstr :: Col -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Col $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Col gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Col -> c Col $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Col -> c Col $cp1Data :: Typeable Col Data, Col -> Col -> Bool (Col -> Col -> Bool) -> (Col -> Col -> Bool) -> Eq Col forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Col -> Col -> Bool $c/= :: Col -> Col -> Bool == :: Col -> Col -> Bool $c== :: Col -> Col -> Bool Eq, Eq Col Eq Col -> (Col -> Col -> Ordering) -> (Col -> Col -> Bool) -> (Col -> Col -> Bool) -> (Col -> Col -> Bool) -> (Col -> Col -> Bool) -> (Col -> Col -> Col) -> (Col -> Col -> Col) -> Ord Col Col -> Col -> Bool Col -> Col -> Ordering Col -> Col -> Col forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Col -> Col -> Col $cmin :: Col -> Col -> Col max :: Col -> Col -> Col $cmax :: Col -> Col -> Col >= :: Col -> Col -> Bool $c>= :: Col -> Col -> Bool > :: Col -> Col -> Bool $c> :: Col -> Col -> Bool <= :: Col -> Col -> Bool $c<= :: Col -> Col -> Bool < :: Col -> Col -> Bool $c< :: Col -> Col -> Bool compare :: Col -> Col -> Ordering $ccompare :: Col -> Col -> Ordering $cp1Ord :: Eq Col Ord, Int -> Col -> ShowS [Col] -> ShowS Col -> String (Int -> Col -> ShowS) -> (Col -> String) -> ([Col] -> ShowS) -> Show Col forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Col] -> ShowS $cshowList :: [Col] -> ShowS show :: Col -> String $cshow :: Col -> String showsPrec :: Int -> Col -> ShowS $cshowsPrec :: Int -> Col -> ShowS Show) -- | Columns start at 1 initCol :: Col initCol :: Col initCol = Int -> Col Col Int 1 -- | Smart constructor for a Col, checks that column >= 1 mkCol :: Int -> Either String Col mkCol :: Int -> Either String Col mkCol Int l | Int l Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 1 = String -> Either String Col forall a b. a -> Either a b Left (String -> Either String Col) -> String -> Either String Col forall a b. (a -> b) -> a -> b $ String "mkCol: called with: " String -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int l String -> ShowS forall a. Semigroup a => a -> a -> a <> String ". Minimum is 1." | Bool otherwise = Col -> Either String Col forall a b. b -> Either a b Right (Int -> Col Col Int l) -- | A position in a text (imagine a cursor) type Position = (Line,Col) -- | The initial position initPosition :: Position initPosition :: Position initPosition = (Line initLine,Col initCol) -- | Given a position, go down a line, going back to the initial column advanceLine :: Position -> Position advanceLine :: Position -> Position advanceLine (Line Int x, Col _) = (Int -> Line Line (Int xInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1), Col initCol) -- | Given a position, advance by one column advanceCol :: Position -> Position advanceCol :: Position -> Position advanceCol (Line ln, Col Int x) = (Line ln, Int -> Col Col (Int xInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1)) -- | Two positions give the lower and upper bounds of a source span type Span = (Position, Position) -- | Type of a reprinting function -- -- @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 deriving Int -> RefactorType -> ShowS [RefactorType] -> ShowS RefactorType -> String (Int -> RefactorType -> ShowS) -> (RefactorType -> String) -> ([RefactorType] -> ShowS) -> Show RefactorType forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [RefactorType] -> ShowS $cshowList :: [RefactorType] -> ShowS show :: RefactorType -> String $cshow :: RefactorType -> String showsPrec :: Int -> RefactorType -> ShowS $cshowsPrec :: Int -> RefactorType -> ShowS 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 :: Reprinting i m -> ast -> i -> m i reprint Reprinting i m reprinting ast ast i input -- If the input is empty return empty | i -> Bool forall a. StringLike a => a -> Bool slNull i input = i -> m i forall (m :: * -> *) a. Monad m => a -> m a return i forall a. Monoid a => a mempty -- Otherwise proceed with the algorithm | Bool otherwise = do -- Initial state comprises start cursor and input source let state_0 :: (Position, i) state_0 = (Position initPosition, i input) -- Enter the top-node of a zipper for `ast' let comp :: StateT (Position, i) m i comp = Reprinting i m -> Zipper ast -> StateT (Position, i) m i forall (m :: * -> *) i ast. (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> StateT (Position, i) m i enter Reprinting i m reprinting (ast -> Zipper ast forall a. Data a => a -> Zipper a toZipper ast ast) (i out, (Position _, i remaining)) <- StateT (Position, i) m i -> (Position, i) -> m (i, (Position, i)) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT StateT (Position, i) m i comp (Position, i) state_0 -- Add to the output source the remaining input source i -> m i forall (m :: * -> *) a. Monad m => a -> m a return (i out i -> i -> i forall a. Semigroup a => a -> a -> a <> i remaining) -- | 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 i m -> Zipper ast -> StateT (Position, i) m i enter Reprinting i m reprinting Zipper ast zipper = do -- Step 1: Apply a refactoring Maybe (RefactorType, i, Span) refactoringInfo <- m (Maybe (RefactorType, i, Span)) -> StateT (Position, i) m (Maybe (RefactorType, i, Span)) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (GenericQ (m (Maybe (RefactorType, i, Span))) -> Zipper ast -> m (Maybe (RefactorType, i, Span)) forall b a. GenericQ b -> Zipper a -> b query GenericQ (m (Maybe (RefactorType, i, Span))) Reprinting i m reprinting Zipper ast zipper) -- Step 2: Deal with refactored code or go to children i output <- case Maybe (RefactorType, i, Span) refactoringInfo of -- No refactoring; go to children Maybe (RefactorType, i, Span) Nothing -> (Zipper ast -> Maybe (Zipper ast)) -> StateT (Position, i) m i forall ast. (Zipper ast -> Maybe (Zipper ast)) -> StateT (Position, i) m i go Zipper ast -> Maybe (Zipper ast) forall a. Zipper a -> Maybe (Zipper a) down' -- A refactoring was applied Just (RefactorType, i, Span) r -> (RefactorType, i, Span) -> StateT (Position, i) m i forall (m :: * -> *) i. (Monad m, StringLike i) => (RefactorType, i, Span) -> StateT (Position, i) m i splice (RefactorType, i, Span) r -- Step 3: Enter the right sibling of the current context i outputSib <- (Zipper ast -> Maybe (Zipper ast)) -> StateT (Position, i) m i forall ast. (Zipper ast -> Maybe (Zipper ast)) -> StateT (Position, i) m i go Zipper ast -> Maybe (Zipper ast) forall a. Zipper a -> Maybe (Zipper a) right -- Finally append output of current context/children -- and right sibling i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return (i output i -> i -> i forall a. Semigroup a => a -> a -> a <> i outputSib) where go :: (Zipper ast -> Maybe (Zipper ast)) -> StateT (Position, i) m i go Zipper ast -> Maybe (Zipper ast) direction = case Zipper ast -> Maybe (Zipper ast) direction Zipper ast zipper of -- Go to next node if there is one Just Zipper ast zipper -> Reprinting i m -> Zipper ast -> StateT (Position, i) m i forall (m :: * -> *) i ast. (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> StateT (Position, i) m i enter Reprinting i m reprinting Zipper ast zipper -- Otherwise return the empty string Maybe (Zipper ast) Nothing -> i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return i forall a. Monoid a => a mempty -- | 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 reprintSort :: Reprinting i m -> ast -> i -> m i reprintSort Reprinting i m reprinting ast ast i input -- If the input is empty return empty | i -> Bool forall a. StringLike a => a -> Bool slNull i input = i -> m i forall (m :: * -> *) a. Monad m => a -> m a return i forall a. Monoid a => a mempty -- Otherwise proceed with the algorithm | Bool otherwise = do -- Initial state comprises start cursor and input source let state_0 :: (Position, i) state_0 = (Position initPosition, i input) -- Enter the top-node of a zipper for `ast' let comp :: StateT (Position, i) m i comp = Reprinting i m -> Zipper ast -> StateT (Position, i) m i forall (m :: * -> *) i ast. (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> StateT (Position, i) m i enter' Reprinting i m reprinting (ast -> Zipper ast forall a. Data a => a -> Zipper a toZipper ast ast) (i out, (Position _, i remaining)) <- StateT (Position, i) m i -> (Position, i) -> m (i, (Position, i)) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT StateT (Position, i) m i comp (Position, i) state_0 -- Add to the output source the remaining input source i -> m i forall (m :: * -> *) a. Monad m => a -> m a return (i out i -> i -> i forall a. Semigroup a => a -> a -> a <> i remaining) -- | 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' :: Reprinting i m -> Zipper ast -> StateT (Position, i) m i enter' Reprinting i m reprinting Zipper ast zipper = do -- Step 1: Get refactorings via AST zipper traversal [(RefactorType, i, Span)] rs <- m [(RefactorType, i, Span)] -> StateT (Position, i) m [(RefactorType, i, Span)] forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m [(RefactorType, i, Span)] -> StateT (Position, i) m [(RefactorType, i, Span)]) -> m [(RefactorType, i, Span)] -> StateT (Position, i) m [(RefactorType, i, Span)] forall a b. (a -> b) -> a -> b $ Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall (m :: * -> *) i ast. (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] getRefactorings Reprinting i m reprinting Zipper ast zipper [] -- Step 2: Do the splicing on the sorted refactorings [i] srcs <- ((RefactorType, i, Span) -> StateT (Position, i) m i) -> [(RefactorType, i, Span)] -> StateT (Position, i) m [i] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (RefactorType, i, Span) -> StateT (Position, i) m i forall (m :: * -> *) i. (Monad m, StringLike i) => (RefactorType, i, Span) -> StateT (Position, i) m i splice ([(RefactorType, i, Span)] -> [(RefactorType, i, Span)] forall a b. [(a, b, Span)] -> [(a, b, Span)] sortBySpan ([(RefactorType, i, Span)] -> [(RefactorType, i, Span)]) -> ([(RefactorType, i, Span)] -> [(RefactorType, i, Span)]) -> [(RefactorType, i, Span)] -> [(RefactorType, i, Span)] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(RefactorType, i, Span)] -> [(RefactorType, i, Span)] forall a. [a] -> [a] reverse ([(RefactorType, i, Span)] -> [(RefactorType, i, Span)]) -> [(RefactorType, i, Span)] -> [(RefactorType, i, Span)] forall a b. (a -> b) -> a -> b $ [(RefactorType, i, Span)] rs) i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return (i -> StateT (Position, i) m i) -> i -> StateT (Position, i) m i forall a b. (a -> b) -> a -> b $ [i] -> i forall a. Monoid a => [a] -> a mconcat [i] srcs where sortBySpan :: [(a, b, Span)] -> [(a, b, Span)] sortBySpan = ((a, b, Span) -> Span) -> [(a, b, Span)] -> [(a, b, Span)] forall b a. Ord b => (a -> b) -> [a] -> [a] sortOn (\(a _,b _,Span sp) -> Span sp) getRefactorings :: (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] getRefactorings :: Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] getRefactorings Reprinting i m reprinting Zipper ast zipper [(RefactorType, i, Span)] acc = do -- Step 1: Apply a refactoring Maybe (RefactorType, i, Span) refactoringInfo <- GenericQ (m (Maybe (RefactorType, i, Span))) -> Zipper ast -> m (Maybe (RefactorType, i, Span)) forall b a. GenericQ b -> Zipper a -> b query GenericQ (m (Maybe (RefactorType, i, Span))) Reprinting i m reprinting Zipper ast zipper -- Step 2: Deal with refactored code or go to children [(RefactorType, i, Span)] acc <- case Maybe (RefactorType, i, Span) refactoringInfo of -- No refactoring; go to children Maybe (RefactorType, i, Span) Nothing -> (Zipper ast -> Maybe (Zipper ast)) -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall ast. (Zipper ast -> Maybe (Zipper ast)) -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] go Zipper ast -> Maybe (Zipper ast) forall a. Zipper a -> Maybe (Zipper a) down' [(RefactorType, i, Span)] acc -- A refactoring was applied, add it to the accumulator Just (RefactorType, i, Span) r -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall (m :: * -> *) a. Monad m => a -> m a return ((RefactorType, i, Span) r (RefactorType, i, Span) -> [(RefactorType, i, Span)] -> [(RefactorType, i, Span)] forall a. a -> [a] -> [a] : [(RefactorType, i, Span)] acc) -- Step 3: Enter the left sibling of the current focus [(RefactorType, i, Span)] acc <- (Zipper ast -> Maybe (Zipper ast)) -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall ast. (Zipper ast -> Maybe (Zipper ast)) -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] go Zipper ast -> Maybe (Zipper ast) forall a. Zipper a -> Maybe (Zipper a) right [(RefactorType, i, Span)] acc -- Finally return the accumulated refactorings [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall (m :: * -> *) a. Monad m => a -> m a return [(RefactorType, i, Span)] acc where go :: (Zipper ast -> Maybe (Zipper ast)) -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] go Zipper ast -> Maybe (Zipper ast) direction [(RefactorType, i, Span)] acc = case Zipper ast -> Maybe (Zipper ast) direction Zipper ast zipper of -- Go to next node if there is one Just Zipper ast zipper -> Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall (m :: * -> *) i ast. (Monad m, StringLike i) => Reprinting i m -> Zipper ast -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] getRefactorings Reprinting i m reprinting Zipper ast zipper [(RefactorType, i, Span)] acc -- Otherwise return the empty string Maybe (Zipper ast) Nothing -> [(RefactorType, i, Span)] -> m [(RefactorType, i, Span)] forall (m :: * -> *) a. Monad m => a -> m a return [(RefactorType, i, Span)] acc splice :: (Monad m, StringLike i) => (RefactorType, i, Span) -> StateT (Position, i) m i splice :: (RefactorType, i, Span) -> StateT (Position, i) m i splice (RefactorType typ, i output, (Position lb, Position ub)) = do (Position cursor, i inp) <- StateT (Position, i) m (Position, i) forall (m :: * -> *) s. Monad m => StateT s m s get case RefactorType typ of RefactorType Replace -> do -- Get soure up to start of refactored node let (i pre, i inp') = Span -> i -> (i, i) forall i. StringLike i => Span -> i -> (i, i) splitBySpan (Position cursor, Position lb) i inp -- Remove source covered by refactoring let (i _, i inp'') = Span -> i -> (i, i) forall i. StringLike i => Span -> i -> (i, i) splitBySpan (Position lb, Position ub) i inp' (Position, i) -> StateT (Position, i) m () forall (m :: * -> *) s. Monad m => s -> StateT s m () put (Position ub, i inp'') i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return (i pre i -> i -> i forall a. Semigroup a => a -> a -> a <> i output) RefactorType After -> do -- Get source up to end of the refactored node let (i pre, i inp') = Span -> i -> (i, i) forall i. StringLike i => Span -> i -> (i, i) splitBySpan (Position cursor, Position ub) i inp (Position, i) -> StateT (Position, i) m () forall (m :: * -> *) s. Monad m => s -> StateT s m () put (Position ub, i inp') i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return (i pre i -> i -> i forall a. Semigroup a => a -> a -> a <> i output) RefactorType Before -> do -- Get source up to start of refactored node let (i pre, i inp') = Span -> i -> (i, i) forall i. StringLike i => Span -> i -> (i, i) splitBySpan (Position cursor, Position lb) i inp -- Discard portion consumed by the refactoring let (i post, i inp'') = Span -> i -> (i, i) forall i. StringLike i => Span -> i -> (i, i) splitBySpan (Position lb, Position ub) i inp' (Position, i) -> StateT (Position, i) m () forall (m :: * -> *) s. Monad m => s -> StateT s m () put (Position ub, i inp'') i -> StateT (Position, i) m i forall (m :: * -> *) a. Monad m => a -> m a return (i pre i -> i -> i forall a. Semigroup a => a -> a -> a <> i output i -> i -> i forall a. Semigroup a => a -> a -> a <> i post) -- | 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 :: Span -> i -> (i, i) splitBySpan (Position lower, Position upper) = i -> Position -> i -> (i, i) forall b a. (StringLike b, StringLike a) => a -> Position -> b -> (a, b) subtext i forall a. Monoid a => a mempty Position lower where subtext :: a -> Position -> b -> (a, b) subtext a acc Position cursor b input | Position cursor Position -> Position -> Bool forall a. Ord a => a -> a -> Bool < Position lower = case b -> Maybe (Char, b) forall a. StringLike a => a -> Maybe (Char, a) slUncons b input of Maybe (Char, b) Nothing -> (a, b) done Just (Char '\n', b input') -> a -> Position -> b -> (a, b) subtext a acc (Position -> Position advanceLine Position cursor) b input' Just (Char _, b input') -> a -> Position -> b -> (a, b) subtext a acc (Position -> Position advanceCol Position cursor) b input' | Position cursor Position -> Position -> Bool forall a. Ord a => a -> a -> Bool < Position upper = case b -> Maybe (Char, b) forall a. StringLike a => a -> Maybe (Char, a) slUncons b input of Maybe (Char, b) Nothing -> (a, b) done Just (Char '\n', b input') -> a -> Position -> b -> (a, b) subtext (Char -> a -> a forall a. StringLike a => Char -> a -> a slCons Char '\n' a acc) (Position -> Position advanceLine Position cursor) b input' Just (Char x, b input') -> a -> Position -> b -> (a, b) subtext (Char -> a -> a forall a. StringLike a => Char -> a -> a slCons Char x a acc) (Position -> Position advanceCol Position cursor) b input' | Bool otherwise = (a, b) done where done :: (a, b) done = (a -> a forall a. StringLike a => a -> a slReverse a acc, b input) -- | Infrastructure for building the reprinter "plugins" class Refactorable t where isRefactored :: t -> Maybe RefactorType getSpan :: t -> Span -- | Essentially wraps the refactorable interface genReprinting :: (Monad m, Refactorable t, Typeable t, StringLike i) => (t -> m i) -> t -> m (Maybe (RefactorType, i, Span)) genReprinting :: (t -> m i) -> t -> m (Maybe (RefactorType, i, Span)) genReprinting t -> m i f t z = case t -> Maybe RefactorType forall t. Refactorable t => t -> Maybe RefactorType isRefactored t z of Maybe RefactorType Nothing -> Maybe (RefactorType, i, Span) -> m (Maybe (RefactorType, i, Span)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (RefactorType, i, Span) forall a. Maybe a Nothing Just RefactorType refactorType -> do i output <- t -> m i f t z Maybe (RefactorType, i, Span) -> m (Maybe (RefactorType, i, Span)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (RefactorType, i, Span) -> m (Maybe (RefactorType, i, Span))) -> Maybe (RefactorType, i, Span) -> m (Maybe (RefactorType, i, Span)) forall a b. (a -> b) -> a -> b $ (RefactorType, i, Span) -> Maybe (RefactorType, i, Span) forall a. a -> Maybe a Just (RefactorType refactorType, i output, t -> Span forall t. Refactorable t => t -> Span getSpan t z) -- | Catch all generic query catchAll :: Monad m => a -> m (Maybe b) catchAll :: a -> m (Maybe b) catchAll a _ = Maybe b -> m (Maybe b) forall (m :: * -> *) a. Monad m => a -> m a return Maybe b forall a. Maybe a Nothing