diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-08-12 04:13:56 +0200 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-08-12 04:13:56 +0200 |
commit | 3473102af04e98117278e5cd2622b9328a6a4dc2 (patch) | |
tree | 0b01f698ed5c08c08a868e84b72ba396db203a97 /src | |
parent | 6a0fe4adb9d2f1b57a742fe0e90c76903c8d7914 (diff) | |
download | stylish-haskell-3473102af04e98117278e5cd2622b9328a6a4dc2.tar.gz |
Make the Change type carry a function inside
Diffstat (limited to 'src')
-rw-r--r-- | src/StylishHaskell/Editor.hs | 37 | ||||
-rw-r--r-- | src/StylishHaskell/Step/Imports.hs | 2 | ||||
-rw-r--r-- | src/StylishHaskell/Step/UnicodeSyntax.hs | 32 |
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 ++ |