Formatting

Options/Applicative/Extra.hs

@@ -164,10 +164,12 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
     with_context c@(Context _ i:_) _ f = f (contextNames c) i
 
     usage_help progn names i = case msg of
-      InfoMsg _ -> mempty
-      _         -> usageHelp $ vcatChunks
-        [ pure . parserUsage pprefs (infoParser i) . unwords $ progn : names
-        , fmap (indent 2) . infoProgDesc $ i ]
+      InfoMsg _
+        -> mempty
+      _
+        -> usageHelp $ vcatChunks
+          [ pure . parserUsage pprefs (infoParser i) . unwords $ progn : names
+          , fmap (indent 2) . infoProgDesc $ i ]
 
     error_help = errorHelp $ case msg of
       ShowHelpText
@@ -192,7 +194,6 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
             --
             -- This gives us the same error we have always
             -- reported
-            --
             msg' = case arg of
               ('-':_) -> "Invalid option `" ++ arg ++ "'"
               _       -> "Invalid argument `" ++ arg ++ "'"
@@ -210,7 +211,6 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
         -- We can make a good help suggestion here if we do
         -- a levenstein distance between all possible suggestions
         -- and the supplied option or argument.
-        --
         -> suggestions
           where
             --

Options/Applicative/Help/Levenshtein.hs

@@ -25,30 +25,48 @@ module Options.Applicative.Help.Levenshtein (
 --   As there are a few ugly partial function calls
 --   there's property tests to ensure it doesn't
 --   crash :/ and obeys the laws.
---
 editDistance :: Eq a => [a] -> [a] -> Int
-editDistance a b
-    = last (if lab == 0 then mainDiag
-            else if lab > 0 then lowers !! (lab - 1)
-                 else {- < 0 -}  uppers !! (-1 - lab))
-    where mainDiag = oneDiag a b (head uppers) (-1 : head lowers)
-          uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals
-          lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals
-          eachDiag _ [] _ = []
-          eachDiag _ _ [] = []
-          eachDiag a' (_:bs) (lastDiag:diags) = oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
-              where nextDiag = head (tail diags)
-          oneDiag a' b' diagAbove diagBelow = thisdiag
-              where doDiag [] _ _ _ _ = []
-                    doDiag _ [] _ _ _ = []
-                    -- Check for a transposition
-                    doDiag (ach:ach':as) (bch:bch':bs) nw n w
-                      | ach' == bch && ach == bch'
-                      = nw : (doDiag (ach':as) (bch':bs) nw (tail n) (tail w))
-                    -- Usual case
-                    doDiag (ach:as) (bch:bs) nw n w = me : (doDiag as bs me (tail n) (tail w))
-                        where me = if ach == bch then nw else 1 + min3 (head w) nw (head n)
-                    firstelt = 1 + head diagBelow
-                    thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)
-          lab = length a - length b
-          min3 x y z = if x < y then x else min y z
+editDistance a b = last $
+  case () of
+    _ | lab == 0
+     -> mainDiag
+      | lab > 0
+     -> lowers !! (lab - 1)
+      | otherwise
+     -> uppers !! (-1 - lab)
+  where
+    mainDiag = oneDiag a b (head uppers) (-1 : head lowers)
+    uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals
+    lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals
+    eachDiag _ [] _ = []
+    eachDiag _ _ [] = []
+    eachDiag a' (_:bs) (lastDiag:diags) =
+      oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
+      where
+        nextDiag = head (tail diags)
+    oneDiag a' b' diagAbove diagBelow = thisdiag
+      where
+        doDiag [] _ _ _ _ = []
+        doDiag _ [] _ _ _ = []
+        -- Check for a transposition
+        -- We don't add anything to nw here, the next character
+        -- will be different however and the transposition
+        -- will have an edit distance of 1.
+        doDiag (ach:ach':as) (bch:bch':bs) nw n w
+          | ach' == bch && ach == bch'
+          = nw : (doDiag (ach' : as) (bch' : bs) nw (tail n) (tail w))
+        -- Standard case
+        doDiag (ach:as) (bch:bs) nw n w =
+          me : (doDiag as bs me (tail n) (tail w))
+          where
+            me =
+              if ach == bch
+                then nw
+                else 1 + min3 (head w) nw (head n)
+        firstelt = 1 + head diagBelow
+        thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)
+    lab = length a - length b
+    min3 x y z =
+      if x < y
+        then x
+        else min y z