Cleaned up Aura.Diff

Aura/Diff.hs

@@ -20,18 +20,27 @@ along with Aura.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
 -- | Coloured diff output, similar to @diff -u@ or @git diff@.
-module Aura.Diff
-    ( unidiff
-    ) where
+module Aura.Diff ( unidiff ) where
 
 import Data.List           (mapAccumL)
 
 import Data.Algorithm.Diff
 
 import Aura.Colour.Text
 
+---
+
+data BlockType = F | S | B
+
+data LineRange = LineRange
+    { start :: !Int  -- ^ The first line of a range.
+    , end   :: !Int  -- ^ The line after the last line of a range.
+    }
+
+type Hunk = [Block]
+
 -- | @takeLast n xs@ returns the last @n@ elements of @xs@, or @xs@ if
--- @n < 'length xs'@.
+-- @n > 'length xs'@.
 takeLast :: Int -> [a] -> [a]
 takeLast n xs = follow (drop n xs) xs
 
@@ -40,13 +49,6 @@ follow []     ys     = ys
 follow xs     []     = xs
 follow (_:xs) (_:ys) = follow xs ys
 
-data BlockType = F | S | B
-
-data LineRange = LineRange
-    { start :: !Int  -- ^ The first line of a range.
-    , end   :: !Int  -- ^ The line after the last line of a range.
-    }
-
 rangeLength :: LineRange -> Int
 rangeLength r = end r - start r
 
@@ -56,17 +58,16 @@ takeRange n (LineRange a b) = LineRange a (min (a + n) b)
 takeLastRange :: Int -> LineRange -> LineRange
 takeLastRange n (LineRange a b) = LineRange (max a (b - n)) b
 
-data Block = Block
-    { tag         :: !BlockType
-    , firstRange  :: !LineRange
-    , secondRange :: !LineRange
-    , content     :: [String]
-    }
+data Block = Block { tag         :: !BlockType
+                   , firstRange  :: !LineRange
+                   , secondRange :: !LineRange
+                   , content     :: [String] }
 
 blockLength :: Block -> Int
-blockLength (Block t f s _) = case t of
-    F -> rangeLength f
-    _ -> rangeLength s
+blockLength (Block t f s _) =
+    case t of
+      F -> rangeLength f
+      _ -> rangeLength s
 
 takeBlock :: Int -> Block -> Block
 takeBlock n (Block t f s c) =
@@ -76,89 +77,73 @@ takeLastBlock :: Int -> Block -> Block
 takeLastBlock n (Block t f s c) =
     Block t (takeLastRange n f) (takeLastRange n s) (takeLast n c)
 
-type Hunk = [Block]
-
 -- | Coloured, unified diff format.
-unidiff
-    :: Int       -- ^ Number of context lines (typically 3)
-    -> String    -- ^ First header
-    -> String    -- ^ Second header
-    -> [String]  -- ^ First file lines
-    -> [String]  -- ^ Second file lines
-    -> [String]  -- ^ Output lines
+unidiff :: Int       -- ^ Number of context lines (typically 3)
+        -> String    -- ^ First header
+        -> String    -- ^ Second header
+        -> [String]  -- ^ First file lines
+        -> [String]  -- ^ Second file lines
+        -> [String]  -- ^ Output lines
 unidiff n from to a b =
     showUnified from to . hunk n . block $ getGroupedDiff a b
 
 block :: [Diff [String]] -> [Block]
 block = snd . mapAccumL go (1, 1)
   where
-    go (a, b) (First  xs) =
+    go (a, b) (First  xs) = let a' = a + length xs in
         ((a', b), Block F (LineRange a a') (LineRange b b) xs)
-      where
-        a' = a + length xs
 
-    go (a, b) (Second xs) =
+    go (a, b) (Second xs) = let b' = b + length xs in
         ((a, b'), Block S (LineRange a a) (LineRange b b') xs)
-      where
-        b' = b + length xs
 
-    go (a, b) (Both xs _) =
+    go (a, b) (Both xs _) = let a' = a + length xs; b' = b + length xs in
         ((a', b'), Block B (LineRange a a') (LineRange b b') xs)
-      where
-        n  = length xs
-        a' = a + n
-        b' = b + n
 
 hunk :: Int -> [Block] -> [Hunk]
 hunk _ []              = []
 hunk _ [Block B _ _ _] = []
 hunk n bs              = go id . trimLast . trimHead $ bs
-  where
-    trimHead (c@(Block B _ _ _):xs) = takeLastBlock n c : xs
-    trimHead xs                     = xs
+    where trimHead (c@(Block B _ _ _):xs) = takeLastBlock n c : xs
+          trimHead xs                     = xs
 
-    trimLast []                     = []
-    trimLast [c@(Block B _ _ _)]    = [takeBlock n c]
-    trimLast (x:xs)                 = x : trimLast xs
+          trimLast []                     = []
+          trimLast [c@(Block B _ _ _)]    = [takeBlock n c]
+          trimLast (x:xs)                 = x : trimLast xs
 
-    -- @front []@ will always be a valid hunk here, because we trimmed the
-    -- last block to fit
-    go front [] = [front []]
+          -- @front []@ will always be a valid hunk here, because we trimmed the
+          -- last block to fit
+          go front [] = [front []]
 
-    -- split and emit hunk when we find a block long enough
-    go front (x:xs) = case tag x of
-        B | blockLength x > 2*n
-            -> front [takeBlock n x] : go (takeLastBlock n x :) xs
-        _   -> go (front . (x:)) xs
+          -- split and emit hunk when we find a block long enough
+          go front (x:xs) =
+              case tag x of
+                B | blockLength x > 2*n
+                    -> front [takeBlock n x] : go (takeLastBlock n x :) xs
+                _   -> go (front . (x:)) xs
 
 showUnified :: String -> String -> [Hunk] -> [String]
 showUnified _    _  [] = []
 showUnified from to hs = header ++ concatMap showHunk hs
-  where
-    header = map bForeground ["--- " ++ from, "+++ " ++ to]
+  where header = map bForeground ["--- " ++ from, "+++ " ++ to]
 
 showHunk :: Hunk -> [String]
 showHunk h = header : concatMap showBlock h
-  where
-    (a, b) = hunkRanges h
-    header = cyan $ "@@ -" ++ showRange a ++ " +" ++ showRange b ++ " @@"
+  where (a, b) = hunkRanges h
+        header = cyan $ "@@ -" ++ showRange a ++ " +" ++ showRange b ++ " @@"
 
 hunkRanges :: Hunk -> (LineRange, LineRange)
 hunkRanges [] = error "hunkRanges: empty hunk"
 hunkRanges xs = (LineRange a a', LineRange b b')
-  where
-    (a , b ) = mapRanges start $ head xs
-    (a', b') = mapRanges end   $ last xs
-
-    mapRanges f c = (f $ firstRange c, f $ secondRange c)
+  where (a , b ) = mapRanges start $ head xs
+        (a', b') = mapRanges end   $ last xs
+        mapRanges f c = (f $ firstRange c, f $ secondRange c)
 
 showRange :: LineRange -> String
 showRange r = show (start r) ++ "," ++ show (rangeLength r)
 
 showBlock :: Block -> [String]
 showBlock b = map (f . (c :)) $ content b
-  where
-    (f, c) = case tag b of
-        F -> (red  , '-')
-        S -> (green, '+')
-        B -> (id   , ' ')
+  where (f, c) = case tag b of
+                   F -> (red  , '-')
+                   S -> (green, '+')
+                   B -> (id   , ' ')