{-# language LambdaCase #-}
module Language.Haskell.Stylish.Editor
( Change
, applyChanges
, change
, changeLine
, delete
, deleteLine
, insert
) where
import Data.List (intercalate, sortOn)
import Language.Haskell.Stylish.Block
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 =
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 :: 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
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 :: 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 []
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 :: 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