{-# 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
    ( Change
    , applyChanges

    , change
    , changeLine
    , delete
    , deleteLine
    , insert
    ) where


--------------------------------------------------------------------------------
import           Data.List                      (intercalate, sortOn)


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


--------------------------------------------------------------------------------
-- | Changes the lines indicated by the 'Block' into the given 'Lines'
data Change a = Change
    { Change a -> Block a
changeBlock :: Block a
    , Change a -> [a] -> [a]
changeLines :: [a] -> [a]
    }


--------------------------------------------------------------------------------
moveChange :: Int -> Change a -> Change a
moveChange :: Int -> Change a -> Change a
moveChange Int
offset (Change Block a
block [a] -> [a]
ls) = Block a -> ([a] -> [a]) -> Change a
forall a. Block a -> ([a] -> [a]) -> Change a
Change (Int -> Block a -> Block a
forall a. Int -> Block a -> Block a
moveBlock Int
offset Block a
block) [a] -> [a]
ls


--------------------------------------------------------------------------------
applyChanges :: [Change a] -> [a] -> [a]
applyChanges :: [Change a] -> [a] -> [a]
applyChanges [Change a]
changes0
    | [Block a] -> Bool
forall a. [Block a] -> Bool
overlapping [Block a]
blocks = [Char] -> [a] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a] -> [a]) -> [Char] -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
        [Char]
"Language.Haskell.Stylish.Editor.applyChanges: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
"refusing to make overlapping changes on lines " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((Block a -> [Char]) -> [Block a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Block a -> [Char]
forall a. Block a -> [Char]
printBlock [Block a]
blocks)
    | Bool
otherwise          = Int -> [Change a] -> [a] -> [a]
forall a. Int -> [Change a] -> [a] -> [a]
go Int
1 [Change a]
changes1
  where
    changes1 :: [Change a]
changes1 = (Change a -> Int) -> [Change a] -> [Change a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Block a -> Int
forall a. Block a -> Int
blockStart (Block a -> Int) -> (Change a -> Block a) -> Change a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change a -> Block a
forall a. Change a -> Block a
changeBlock) [Change a]
changes0
    blocks :: [Block a]
blocks   = (Change a -> Block a) -> [Change a] -> [Block a]
forall a b. (a -> b) -> [a] -> [b]
map Change a -> Block a
forall a. Change a -> Block a
changeBlock [Change a]
changes1

    printBlock :: Block a -> [Char]
printBlock Block a
b = Int -> [Char]
forall a. Show a => a -> [Char]
show (Block a -> Int
forall a. Block a -> Int
blockStart Block a
b) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Block a -> Int
forall a. Block a -> Int
blockEnd Block a
b)

    go :: Int -> [Change a] -> [a] -> [a]
go Int
_ []                [a]
ls = [a]
ls
    go Int
n (Change a
ch : [Change a]
chs) [a]
ls =
        -- Divide the remaining lines into:
        --
        -- > pre
        -- > old  (lines that are affected by the change)
        -- > post
        --
        -- And generate:
        --
        -- > pre
        -- > new
        -- > (recurse)
        --
        let block :: Block a
block       = Change a -> Block a
forall a. Change a -> Block a
changeBlock Change a
ch
            ([a]
pre, [a]
ls')  = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Block a -> Int
forall a. Block a -> Int
blockStart Block a
block Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
ls
            ([a]
old, [a]
post) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Block a -> Int
forall a. Block a -> Int
blockLength Block a
block) [a]
ls'
            new :: [a]
new         = Change a -> [a] -> [a]
forall a. Change a -> [a] -> [a]
changeLines Change a
ch [a]
old
            extraLines :: Int
extraLines  = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
new Int -> Int -> Int
forall a. Num a => a -> a -> a
- Block a -> Int
forall a. Block a -> Int
blockLength Block a
block
            chs' :: [Change a]
chs'        = (Change a -> Change a) -> [Change a] -> [Change a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Change a -> Change a
forall a. Int -> Change a -> Change a
moveChange Int
extraLines) [Change a]
chs
            n' :: Int
n'          = Block a -> Int
forall a. Block a -> Int
blockStart Block a
block Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Block a -> Int
forall a. Block a -> Int
blockLength Block a
block Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extraLines
        in [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
new [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [Change a] -> [a] -> [a]
go Int
n' [Change a]
chs' [a]
post


--------------------------------------------------------------------------------
-- | Change a block of lines for some other lines
change :: Block a -> ([a] -> [a]) -> Change a
change :: Block a -> ([a] -> [a]) -> Change a
change = Block a -> ([a] -> [a]) -> Change a
forall a. Block a -> ([a] -> [a]) -> Change a
Change


--------------------------------------------------------------------------------
-- | Change a single line for some other lines
changeLine :: Int -> (a -> [a]) -> Change a
changeLine :: Int -> (a -> [a]) -> Change a
changeLine Int
start a -> [a]
f = Block a -> ([a] -> [a]) -> Change a
forall a. Block a -> ([a] -> [a]) -> Change a
change (Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block Int
start Int
start) (([a] -> [a]) -> Change a) -> ([a] -> [a]) -> Change a
forall a b. (a -> b) -> a -> b
$ \case
    []      -> []
    (a
x : [a]
_) -> a -> [a]
f a
x


--------------------------------------------------------------------------------
-- | Delete a block of lines
delete :: Block a -> Change a
delete :: Block a -> Change a
delete Block a
block = Block a -> ([a] -> [a]) -> Change a
forall a. Block a -> ([a] -> [a]) -> Change a
Change Block a
block (([a] -> [a]) -> Change a) -> ([a] -> [a]) -> Change a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a]
forall a b. a -> b -> a
const []


--------------------------------------------------------------------------------
-- | Delete a single line
deleteLine :: Int -> Change a
deleteLine :: Int -> Change a
deleteLine Int
start = Block a -> Change a
forall a. Block a -> Change a
delete (Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block Int
start Int
start)


--------------------------------------------------------------------------------
-- | Insert something /before/ the given lines
insert :: Int -> [a] -> Change a
insert :: Int -> [a] -> Change a
insert Int
start = Block a -> ([a] -> [a]) -> Change a
forall a. Block a -> ([a] -> [a]) -> Change a
Change (Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block Int
start (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (([a] -> [a]) -> Change a)
-> ([a] -> [a] -> [a]) -> [a] -> Change a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a b. a -> b -> a
const