{-# LANGUAGE LambdaCase #-}

--------------------------------------------------------------------------------
-- | This module provides you with a line-based editor. It's main feature is
-- that you can specify multiple changes at the same time, e.g.:
--
-- > [deleteLine 3, changeLine 4 ["Foo"]]
--
-- when this is evaluated, we take into account that 4th line will become the
-- 3rd line before it needs changing.
module Language.Haskell.Stylish.Editor
    ( module Language.Haskell.Stylish.Block

    , Edits
    , apply

    , replace
    , replaceRealSrcSpan
    , changeLine
    , changeLines
    , insertLines
    ) where


--------------------------------------------------------------------------------
import qualified Data.Map                       as M
import           Data.Maybe                     (fromMaybe)
import qualified GHC.Types.SrcLoc               as GHC


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Block


--------------------------------------------------------------------------------
data Change
    -- | Insert some lines.
    = CInsert [String]
    -- | Replace the block of N lines by the given lines.
    | CBlock Int ([String] -> [String])
    -- | Replace (startCol, endCol) by the given string on this line.
    | CLine Int Int String


--------------------------------------------------------------------------------
-- | Due to the function in CBlock we cannot write a lawful Ord instance, but
-- this lets us merge-sort changes.
beforeChange :: Change -> Change -> Bool
beforeChange :: Change -> Change -> Bool
beforeChange (CInsert [String]
_)   Change
_             = Bool
True
beforeChange Change
_             (CInsert [String]
_)   = Bool
False
beforeChange (CBlock Int
_ [String] -> [String]
_)  Change
_             = Bool
True
beforeChange Change
_             (CBlock Int
_ [String] -> [String]
_)  = Bool
False
beforeChange (CLine Int
x Int
_ String
_) (CLine Int
y Int
_ String
_) = Int
x forall a. Ord a => a -> a -> Bool
<= Int
y


--------------------------------------------------------------------------------
prettyChange :: Int -> Change -> String
prettyChange :: Int -> Change -> String
prettyChange Int
l (CInsert [String]
ls) =
    forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
" insert " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls) forall a. [a] -> [a] -> [a]
++ String
" lines"
prettyChange Int
l (CBlock Int
n [String] -> [String]
_) = forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
l forall a. Num a => a -> a -> a
+ Int
n) forall a. [a] -> [a] -> [a]
++ String
" replace lines"
prettyChange Int
l (CLine Int
start Int
end String
x) =
    forall a. Show a => a -> String
show Int
l forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
start forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
end forall a. [a] -> [a] -> [a]
++ String
" replace by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
x


--------------------------------------------------------------------------------
-- | Merge in order
mergeChanges :: [Change] -> [Change] -> [Change]
mergeChanges :: [Change] -> [Change] -> [Change]
mergeChanges = [Change] -> [Change] -> [Change]
go
  where
    go :: [Change] -> [Change] -> [Change]
go []       [Change]
ys       = [Change]
ys
    go [Change]
xs       []       = [Change]
xs
    go (Change
x : [Change]
xs) (Change
y : [Change]
ys) =
        if Change
x Change -> Change -> Bool
`beforeChange` Change
y then Change
x forall a. a -> [a] -> [a]
: [Change] -> [Change] -> [Change]
go [Change]
xs (Change
y forall a. a -> [a] -> [a]
: [Change]
ys) else Change
y forall a. a -> [a] -> [a]
: [Change] -> [Change] -> [Change]
go (Change
x forall a. a -> [a] -> [a]
: [Change]
xs) [Change]
ys


--------------------------------------------------------------------------------
-- Stores sorted spans to change per line.
newtype Edits = Edits {Edits -> Map Int [Change]
unEdits :: M.Map Int [Change]}


--------------------------------------------------------------------------------
instance Show Edits where
    show :: Edits -> String
show Edits
edits = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ do
        (Int
line, [Change]
changes) <- forall k a. Map k a -> [(k, a)]
M.toAscList forall a b. (a -> b) -> a -> b
$ Edits -> Map Int [Change]
unEdits Edits
edits
        Int -> Change -> String
prettyChange Int
line forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Change]
changes


--------------------------------------------------------------------------------
instance Semigroup Edits where
    Edits Map Int [Change]
l <> :: Edits -> Edits -> Edits
<> Edits Map Int [Change]
r = Map Int [Change] -> Edits
Edits forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Change] -> [Change] -> [Change]
mergeChanges Map Int [Change]
l Map Int [Change]
r


--------------------------------------------------------------------------------
instance Monoid Edits where
    mempty :: Edits
mempty = Map Int [Change] -> Edits
Edits forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
replaceRealSrcSpan :: GHC.RealSrcSpan -> String -> Edits
replaceRealSrcSpan :: RealSrcSpan -> String -> Edits
replaceRealSrcSpan RealSrcSpan
rss String
repl
    | RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
rss forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
rss = forall a. Monoid a => a
mempty
    | Bool
otherwise                                          = Int -> Int -> Int -> String -> Edits
replace
        (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
rss)
        (RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
rss)
        (RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
rss)
        String
repl


--------------------------------------------------------------------------------
replace :: Int -> Int -> Int -> String -> Edits
replace :: Int -> Int -> Int -> String -> Edits
replace Int
line Int
startCol Int
endCol String
repl
    | Int
startCol forall a. Ord a => a -> a -> Bool
> Int
endCol = forall a. Monoid a => a
mempty
    | Bool
otherwise         =
        Map Int [Change] -> Edits
Edits forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton Int
line [Int -> Int -> String -> Change
CLine Int
startCol Int
endCol String
repl]


--------------------------------------------------------------------------------
changeLine :: Int -> (String -> [String]) -> Edits
changeLine :: Int -> (String -> [String]) -> Edits
changeLine Int
start String -> [String]
f = Block String -> ([String] -> [String]) -> Edits
changeLines (forall a. Int -> Int -> Block a
Block Int
start Int
start) forall a b. (a -> b) -> a -> b
$ \[String]
ls -> case [String]
ls of
    String
l : [String]
_ -> String -> [String]
f String
l
    [String]
_     -> String -> [String]
f String
""


--------------------------------------------------------------------------------
changeLines :: Block String -> ([String] -> [String]) -> Edits
changeLines :: Block String -> ([String] -> [String]) -> Edits
changeLines (Block Int
start Int
end) [String] -> [String]
f =
    Map Int [Change] -> Edits
Edits forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton Int
start [Int -> ([String] -> [String]) -> Change
CBlock (Int
end forall a. Num a => a -> a -> a
- Int
start forall a. Num a => a -> a -> a
+ Int
1) [String] -> [String]
f]


--------------------------------------------------------------------------------
insertLines :: Int -> [String] -> Edits
insertLines :: Int -> [String] -> Edits
insertLines Int
line [String]
ls = Map Int [Change] -> Edits
Edits forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton Int
line [[String] -> Change
CInsert [String]
ls]


--------------------------------------------------------------------------------
data Conflict = Conflict Int Change Int Change


--------------------------------------------------------------------------------
prettyConflict :: Conflict -> String
prettyConflict :: Conflict -> String
prettyConflict (Conflict Int
l1 Change
c1 Int
l2 Change
c2) = [String] -> String
unlines
    [ String
"Conflict between edits:"
    , String
"- " forall a. [a] -> [a] -> [a]
++ Int -> Change -> String
prettyChange Int
l1 Change
c1
    , String
"- " forall a. [a] -> [a] -> [a]
++ Int -> Change -> String
prettyChange Int
l2 Change
c2
    ]


--------------------------------------------------------------------------------
conflicts :: Edits -> [Conflict]
conflicts :: Edits -> [Conflict]
conflicts (Edits Map Int [Change]
edits) = forall k a. Map k a -> [(k, a)]
M.toAscList Map Int [Change]
edits forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [Change] -> [Conflict]
checkChanges
  where
    checkChanges :: Int -> [Change] -> [Conflict]
checkChanges Int
_ [] = []
    checkChanges Int
i (CInsert [String]
_ : [Change]
cs) = Int -> [Change] -> [Conflict]
checkChanges Int
i [Change]
cs
    checkChanges Int
i (c1 :: Change
c1@(CBlock Int
_ [String] -> [String]
_) : Change
c2 : [Change]
_) = [Int -> Change -> Int -> Change -> Conflict
Conflict Int
i Change
c1 Int
i Change
c2]
    checkChanges Int
i [c1 :: Change
c1@(CBlock Int
n [String] -> [String]
_)] = do
        Int
i' <- [Int
i forall a. Num a => a -> a -> a
+ Int
1 .. Int
i forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
1]
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i' Map Int [Change]
edits of
            Just (Change
c2 : [Change]
_) -> [Int -> Change -> Int -> Change -> Conflict
Conflict Int
i Change
c1 Int
i' Change
c2]
            Maybe [Change]
_             -> []
    checkChanges Int
i (c1 :: Change
c1@(CLine Int
xstart Int
xend String
_) : c2 :: Change
c2@(CLine Int
ystart Int
_ String
_) : [Change]
cs)
        | Int
xstart forall a. Eq a => a -> a -> Bool
== Int
ystart = [Int -> Change -> Int -> Change -> Conflict
Conflict Int
i Change
c1 Int
i Change
c2]
        | Int
xend forall a. Ord a => a -> a -> Bool
> Int
ystart    = [Int -> Change -> Int -> Change -> Conflict
Conflict Int
i Change
c1 Int
i Change
c2]
        | Bool
otherwise        = Int -> [Change] -> [Conflict]
checkChanges Int
i (Change
c2 forall a. a -> [a] -> [a]
: [Change]
cs)
    checkChanges Int
_ (CLine Int
_ Int
_ String
_ : [Change]
_) = []


--------------------------------------------------------------------------------
apply :: Edits -> [String] -> [String]
apply :: Edits -> [String] -> [String]
apply (Edits Map Int [Change]
edits) = case Edits -> [Conflict]
conflicts (Map Int [Change] -> Edits
Edits Map Int [Change]
edits) of
    Conflict
c : [Conflict]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Language.Haskell.Stylish.Editor: " forall a. [a] -> [a] -> [a]
++ Conflict -> String
prettyConflict Conflict
c
    [Conflict]
_     -> Int -> [Change] -> [String] -> [String]
go Int
1 (Int -> [Change]
editsFor Int
1)
  where
    editsFor :: Int -> [Change]
editsFor Int
i = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i Map Int [Change]
edits

    go :: Int -> [Change] -> [String] -> [String]
go Int
_ [Change]
_ [] = []
    go Int
i [] (String
l : [String]
ls) = String
l forall a. a -> [a] -> [a]
: Int -> [Change] -> [String] -> [String]
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int -> [Change]
editsFor forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1) [String]
ls
    go Int
i (CInsert [String]
ls' : [Change]
cs) [String]
ls = [String]
ls' forall a. [a] -> [a] -> [a]
++ Int -> [Change] -> [String] -> [String]
go Int
i [Change]
cs [String]
ls
    go Int
i (CBlock Int
n [String] -> [String]
f : [Change]
_cs) [String]
ls =
        let ([String]
domain, [String]
ls') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
ls in
        [String] -> [String]
f [String]
domain forall a. [a] -> [a] -> [a]
++ Int -> [Change] -> [String] -> [String]
go (Int
i forall a. Num a => a -> a -> a
+ Int
n) (Int -> [Change]
editsFor forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
n) [String]
ls'
    go Int
i (CLine Int
xstart Int
xend String
x : [Change]
cs) (String
l : [String]
ls) =
        let l' :: String
l' = forall a. Int -> [a] -> [a]
take (Int
xstart forall a. Num a => a -> a -> a
- Int
1) String
l forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (Int
xend forall a. Num a => a -> a -> a
- Int
1) String
l in
        Int -> [Change] -> [String] -> [String]
go Int
i (forall {t :: * -> *} {a}.
Foldable t =>
Int -> Int -> t a -> Change -> Change
adjust Int
xstart Int
xend String
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Change]
cs) (String
l' forall a. a -> [a] -> [a]
: [String]
ls)

    adjust :: Int -> Int -> t a -> Change -> Change
adjust Int
_ Int
_ t a
_ (CInsert [String]
xs) = [String] -> Change
CInsert [String]
xs
    adjust Int
_ Int
_ t a
_ (CBlock Int
n [String] -> [String]
f) = Int -> ([String] -> [String]) -> Change
CBlock Int
n [String] -> [String]
f
    adjust Int
xstart Int
xend t a
x (CLine Int
ystart Int
yend String
y)
        | Int
ystart forall a. Ord a => a -> a -> Bool
>= Int
xend =
            let offset :: Int
offset = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x forall a. Num a => a -> a -> a
- (Int
xend forall a. Num a => a -> a -> a
- Int
xstart) in
            Int -> Int -> String -> Change
CLine (Int
ystart forall a. Num a => a -> a -> a
+ Int
offset) (Int
yend forall a. Num a => a -> a -> a
+ Int
offset) String
y
        | Bool
otherwise     = Int -> Int -> String -> Change
CLine Int
ystart Int
yend String
y