summaryrefslogtreecommitdiffhomepage
path: root/lib/Language/Haskell/Stylish/Editor.hs
blob: cad7e68b61c312692e070932bcf941071520955d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
--------------------------------------------------------------------------------
-- | 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, sortBy)
import           Data.Ord                       (comparing)


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


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


--------------------------------------------------------------------------------
moveChange :: Int -> Change a -> Change a
moveChange offset (Change block ls) = Change (moveBlock offset block) ls


--------------------------------------------------------------------------------
applyChanges :: [Change a] -> [a] -> [a]
applyChanges changes0
    | overlapping blocks = error $
        "Language.Haskell.Stylish.Editor.applyChanges: " ++
        "refusing to make overlapping changes on lines " ++
        intercalate ", " (map printBlock blocks)
    | otherwise          = go 1 changes1
  where
    changes1 = sortBy (comparing (blockStart . changeBlock)) changes0
    blocks   = map changeBlock changes1

    printBlock b = show (blockStart b) ++ "-" ++ show (blockEnd b)

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


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


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


--------------------------------------------------------------------------------
-- | Delete a block of lines
delete :: Block a -> Change a
delete block = Change block $ const []


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


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