{-# 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