Make the Change type carry a function inside

3 files changed, 28 insertions, 43 deletions

diff --git a/src/StylishHaskell/Editor.hs b/src/StylishHaskell/Editor.hs
index 2143102..072cb10 100644
--- a/src/StylishHaskell/Editor.hs
+++ b/src/StylishHaskell/Editor.hs
@@ -26,8 +26,8 @@ import           StylishHaskell.Block
 -- | Changes the lines indicated by the 'Block' into the given 'Lines'
 data Change a = Change
     { changeBlock :: Block a
-    , changeLines :: [a]
-    } deriving (Eq, Show)
+    , changeLines :: ([a] -> [a])
+    }
 
 
 --------------------------------------------------------------------------------
@@ -36,12 +36,6 @@ moveChange offset (Change block ls) = Change (moveBlock offset block) ls
 
 
 --------------------------------------------------------------------------------
--- | Number of additional lines introduced when a change is made.
-changeExtraLines :: Change a -> Int
-changeExtraLines (Change block ls) = length ls - blockLength block
-
-
---------------------------------------------------------------------------------
 applyChanges :: [Change a] -> [a] -> [a]
 applyChanges changes
     | overlapping blocks = error $
@@ -65,31 +59,34 @@ applyChanges changes
         -- > new
         -- > (recurse)
         --
-        let block      = changeBlock ch
-            (pre, ls') = splitAt (blockStart block - n) ls
-            (_, post)  = splitAt (blockLength block) ls'
-            extraLines = changeExtraLines ch
-            chs'       = map (moveChange extraLines) chs
-            n'         = blockStart block + blockLength block + extraLines
-        in pre ++ (changeLines ch) ++ go n' chs' post
+        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] -> Change a
+change :: Block a -> ([a] -> [a]) -> Change a
 change = Change
 
 
 --------------------------------------------------------------------------------
 -- | Change a single line for some other lines
-changeLine :: Int -> [a] -> Change a
-changeLine start = change (Block start start)
+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 []
+delete block = Change block $ const []
 
 
 --------------------------------------------------------------------------------
@@ -101,4 +98,4 @@ deleteLine start = delete (Block start start)
 --------------------------------------------------------------------------------
 -- | Insert something /before/ the given lines
 insert :: Int -> [a] -> Change a
-insert start = Change (Block start (start - 1))
+insert start = Change (Block start (start - 1)) . const
diff --git a/src/StylishHaskell/Step/Imports.hs b/src/StylishHaskell/Step/Imports.hs
index 5783c58..b5a2899 100644
--- a/src/StylishHaskell/Step/Imports.hs
+++ b/src/StylishHaskell/Step/Imports.hs
@@ -165,7 +165,7 @@ step columns = makeStep "Imports" . step' columns
 --------------------------------------------------------------------------------
 step' :: Int -> Align -> Lines -> Module -> Lines
 step' columns align ls (module', _) = flip applyChanges ls
-    [ change block (prettyImportGroup columns align longest importGroup)
+    [ change block (const $ prettyImportGroup columns align longest importGroup)
     | (block, importGroup) <- groups
     ]
   where
diff --git a/src/StylishHaskell/Step/UnicodeSyntax.hs b/src/StylishHaskell/Step/UnicodeSyntax.hs
index 3311b0e..c866c5f 100644
--- a/src/StylishHaskell/Step/UnicodeSyntax.hs
+++ b/src/StylishHaskell/Step/UnicodeSyntax.hs
@@ -30,28 +30,16 @@ unicodeReplacements = M.fromList
 
 
 --------------------------------------------------------------------------------
-replaceAll :: [(Int, [(Int, String)])] -> Lines -> [Change String]
-replaceAll positions ls =
-    zipWith changeLine' positions $ selectLines (map fst positions) ls
+replaceAll :: [(Int, [(Int, String)])] -> [Change String]
+replaceAll = map changeLine'
   where
-    changeLine' (r, ns) str = changeLine r $ return $ flip applyChanges str
-        [ change (Block c ec) repl
-        | (c, needle) <- sort ns
-        , let ec = c + length needle - 1
-        , repl <- maybeToList $ M.lookup needle unicodeReplacements
-        ]
-
-
-
---------------------------------------------------------------------------------
-selectLines :: [Int] -> Lines -> [String]
-selectLines = go 1
-  where
-    go _ []      _         = []
-    go _ _       []        = []
-    go r (x : xs) (l : ls)
-        | r == x                    = l : go (r + 1) xs ls
-        | otherwise                 = go (r + 1) (x : xs) ls
+    changeLine' (r, ns) = changeLine r $ \str -> return $
+        flip applyChanges str
+            [ change (Block c ec) (const repl)
+            | (c, needle) <- sort ns
+            , let ec = c + length needle - 1
+            , repl <- maybeToList $ M.lookup needle unicodeReplacements
+            ]
 
 
 --------------------------------------------------------------------------------
@@ -120,7 +108,7 @@ step' :: Bool -> Lines -> Module -> Lines
 step' alp ls (module', _) = applyChanges changes ls
   where
     changes = (if alp then addLanguagePragma "UnicodeSyntax" module' else []) ++
-        replaceAll perLine ls
+        replaceAll perLine
     perLine = sort $ groupPerLine $
         typeSigs module' ls ++
         contexts module' ls ++