Formmatting fixes to CmdLineParser

1 files changed, 93 insertions, 89 deletions

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index c4bfe3abe7..c0301dc29b 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -1,22 +1,23 @@
------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
 --
--- Command-line parser
+-- | Command-line parser
 --
 -- This is an abstract command-line parser used by both StaticFlags and
 -- DynFlags.
 --
 -- (c) The University of Glasgow 2005
 --
------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
 
-module CmdLineParser (
-        processArgs, OptKind(..),
-        CmdLineP(..), getCmdLineState, putCmdLineState,
-        Flag(..),
-        errorsToGhcException,
+module CmdLineParser
+    (
+      processArgs, OptKind(..),
+      CmdLineP(..), getCmdLineState, putCmdLineState,
+      Flag(..),
+      errorsToGhcException,
 
-        EwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
-  ) where
+      EwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
+    ) where
 
 #include "HsVersions.h"
 
@@ -28,28 +29,28 @@ import SrcLoc
 
 import Data.List
 
+
 --------------------------------------------------------
 --         The Flag and OptKind types
 --------------------------------------------------------
 
 data Flag m = Flag
-    {   flagName    :: String,       -- Flag, without the leading "-"
-        flagOptKind :: OptKind m     -- What to do if we see it
+    {   flagName    :: String,   -- Flag, without the leading "-"
+        flagOptKind :: OptKind m -- What to do if we see it
     }
 
--------------------------------
-data OptKind m                       -- Suppose the flag is -f
- = NoArg     (EwM m ())                 -- -f all by itself
- | HasArg    (String -> EwM m ())       -- -farg or -f arg
- | SepArg    (String -> EwM m ())       -- -f arg
- | Prefix    (String -> EwM m ())       -- -farg
- | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)
- | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
- | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn
- | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn
- | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn
- | PrefixPred    (String -> Bool) (String -> EwM m ())
- | AnySuffixPred (String -> Bool) (String -> EwM m ())
+data OptKind m                             -- Suppose the flag is -f
+    = NoArg     (EwM m ())                 -- -f all by itself
+    | HasArg    (String -> EwM m ())       -- -farg or -f arg
+    | SepArg    (String -> EwM m ())       -- -f arg
+    | Prefix    (String -> EwM m ())       -- -farg
+    | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)
+    | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn
+    | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn
+    | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn
+    | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn
+    | PrefixPred    (String -> Bool) (String -> EwM m ())
+    | AnySuffixPred (String -> Bool) (String -> EwM m ())
 
 
 --------------------------------------------------------
@@ -61,16 +62,16 @@ type Warn  = Located String
 type Errs  = Bag Err
 type Warns = Bag Warn
 
--- EwM (short for "errors and warnings monad") is a
--- monad transformer for m that adds an (err, warn) state
-newtype EwM m a = EwM { unEwM :: Located String     -- Current arg
+-- EwM ("errors and warnings monad") is a monad
+-- transformer for m that adds an (err, warn) state
+newtype EwM m a = EwM { unEwM :: Located String -- Current parse arg
                               -> Errs -> Warns
                               -> m (Errs, Warns, a) }
 
 instance Monad m => Monad (EwM m) where
-  (EwM f) >>= k = EwM (\l e w -> do (e', w', r) <- f l e w
-                                    unEwM (k r) l e' w')
-  return v = EwM (\_ e w -> return (e, w, v))
+    (EwM f) >>= k = EwM (\l e w -> do (e', w', r) <- f l e w
+                                      unEwM (k r) l e' w')
+    return v = EwM (\_ e w -> return (e, w, v))
 
 setArg :: Monad m => Located String -> EwM m () -> EwM m ()
 setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
@@ -80,13 +81,12 @@ addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` L loc e, ws, ()))
 
 addWarn :: Monad m => String -> EwM m ()
 addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ()))
-  where
-    w = "Warning: " ++ msg
+  where w = "Warning: " ++ msg
 
 deprecate :: Monad m => String -> EwM m ()
-deprecate s
-  = do arg <- getArg
-       addWarn (arg ++ " is deprecated: " ++ s)
+deprecate s = do
+    arg <- getArg
+    addWarn (arg ++ " is deprecated: " ++ s)
 
 getArg :: Monad m => EwM m String
 getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))
@@ -97,17 +97,20 @@ getCurLoc = EwM (\(L loc _) es ws -> return (es, ws, loc))
 liftEwM :: Monad m => m a -> EwM m a
 liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
 
--- -----------------------------------------------------------------------------
+
+--------------------------------------------------------
 -- A state monad for use in the command-line parser
--- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
+--------------------------------------------------------
 
+-- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)
 newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
 
 instance Monad (CmdLineP s) where
-        return a = CmdLineP $ \s -> (a, s)
-        m >>= k  = CmdLineP $ \s -> let
-                (a, s') = runCmdLine m s
-                in runCmdLine (k a) s'
+    m >>= k = CmdLineP $ \s ->
+                  let (a, s') = runCmdLine m s
+                  in runCmdLine (k a) s'
+
+    return a = CmdLineP $ \s -> (a, s)
 
 getCmdLineState :: CmdLineP s s
 getCmdLineState   = CmdLineP $ \s -> (s,s)
@@ -120,36 +123,34 @@ putCmdLineState s = CmdLineP $ \_ -> ((),s)
 --------------------------------------------------------
 
 processArgs :: Monad m
-            => [Flag m] -- cmdline parser spec
-            -> [Located String]      -- args
-            -> m (
-                  [Located String],  -- spare args
-                  [Located String],  -- errors
-                  [Located String]   -- warnings
-                 )
-processArgs spec args
-  = let action = process args []
-    in do (errs, warns, spare) <- unEwM action (panic "processArgs: no arg yet")
+            => [Flag m]               -- cmdline parser spec
+            -> [Located String]       -- args
+            -> m ( [Located String],  -- spare args
+                   [Located String],  -- errors
+                   [Located String] ) -- warnings
+processArgs spec args = do
+    (errs, warns, spare) <- unEwM action (panic "processArgs: no arg yet")
                                   emptyBag emptyBag
-          return (spare, bagToList errs, bagToList warns)
+    return (spare, bagToList errs, bagToList warns)
   where
+    action = process args []
+
     -- process :: [Located String] -> [Located String] -> EwM m [Located String]
-    --
     process [] spare = return (reverse spare)
 
     process (locArg@(L _ ('-' : arg)) : args) spare =
-      case findArg spec arg of
-        Just (rest, opt_kind) ->
-           case processOneArg opt_kind rest arg args of
-               Left err ->
-                   let b = process args spare
-                   in (setArg locArg $ addErr err) >> b
+        case findArg spec arg of
+            Just (rest, opt_kind) ->
+                case processOneArg opt_kind rest arg args of
+                    Left err ->
+                        let b = process args spare
+                        in (setArg locArg $ addErr err) >> b
 
-               Right (action,rest) ->
-                   let b = process rest spare
-                   in (setArg locArg $ action) >> b
+                    Right (action,rest) ->
+                        let b = process rest spare
+                        in (setArg locArg $ action) >> b
 
-        Nothing -> process args (locArg : spare)
+            Nothing -> process args (locArg : spare)
 
     process (arg : args) spare = process args (arg : spare)
 
@@ -163,16 +164,16 @@ processOneArg opt_kind rest arg args
         NoArg  a -> ASSERT(null rest) Right (a, args)
 
         HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
-                 | otherwise    -> case args of
-                                    [] -> missingArgErr dash_arg
+                 | otherwise -> case args of
+                                    []               -> missingArgErr dash_arg
                                     (L _ arg1:args1) -> Right (f arg1, args1)
 
         SepArg f -> case args of
-                        [] -> unknownFlagErr dash_arg
+                        []               -> unknownFlagErr dash_arg
                         (L _ arg1:args1) -> Right (f arg1, args1)
 
         Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)
-                 | otherwise  -> unknownFlagErr dash_arg
+                 | otherwise          -> unknownFlagErr dash_arg
 
         PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args)
                        | otherwise          -> unknownFlagErr dash_arg
@@ -193,8 +194,8 @@ processOneArg opt_kind rest arg args
 
 
 findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
-findArg spec arg
-  = case [ (removeSpaces rest, optKind)
+findArg spec arg =
+    case [ (removeSpaces rest, optKind)
          | flag <- spec,
            let optKind  = flagOptKind flag,
            Just rest <- [stripPrefix (flagName flag) arg],
@@ -204,28 +205,30 @@ findArg spec arg
         (one:_) -> Just one
 
 arg_ok :: OptKind t -> [Char] -> String -> Bool
-arg_ok (NoArg _)            rest _   = null rest
-arg_ok (HasArg _)           _    _   = True
-arg_ok (SepArg _)           rest _   = null rest
-arg_ok (Prefix _)           rest _   = notNull rest
-arg_ok (PrefixPred p _)     rest _   = notNull rest && p (dropEq rest)
-arg_ok (OptIntSuffix _)     _    _   = True
-arg_ok (IntSuffix _)        _    _   = True
-arg_ok (OptPrefix _)        _    _   = True
-arg_ok (PassFlag _)         rest _   = null rest
-arg_ok (AnySuffix _)        _    _   = True
+arg_ok (NoArg           _)  rest _   = null rest
+arg_ok (HasArg          _)  _    _   = True
+arg_ok (SepArg          _)  rest _   = null rest
+arg_ok (Prefix          _)  rest _   = notNull rest
+arg_ok (PrefixPred p    _)  rest _   = notNull rest && p (dropEq rest)
+arg_ok (OptIntSuffix    _)  _    _   = True
+arg_ok (IntSuffix       _)  _    _   = True
+arg_ok (OptPrefix       _)  _    _   = True
+arg_ok (PassFlag        _)  rest _   = null rest
+arg_ok (AnySuffix       _)  _    _   = True
 arg_ok (AnySuffixPred p _)  _    arg = p arg
 
-parseInt :: String -> Maybe Int
+-- | Parse an Int
+--
 -- Looks for "433" or "=342", with no trailing gubbins
---   n or =n      => Just n
---   gibberish    => Nothing
+--   * n or =n      => Just n
+--   * gibberish    => Nothing
+parseInt :: String -> Maybe Int
 parseInt s = case reads s of
-                ((n,""):_) -> Just n
-                _          -> Nothing
+                 ((n,""):_) -> Just n
+                 _          -> Nothing
 
+-- | Discards a leading equals sign
 dropEq :: String -> String
--- Discards a leading equals sign
 dropEq ('=' : s) = s
 dropEq s         = s
 
@@ -235,11 +238,12 @@ unknownFlagErr f = Left ("unrecognised flag: " ++ f)
 missingArgErr :: String -> Either String a
 missingArgErr f = Left ("missing argument for flag: " ++ f)
 
--- ---------------------------------------------------------------------
+--------------------------------------------------------
 -- Utils
+--------------------------------------------------------
 
 errorsToGhcException :: [Located String] -> GhcException
 errorsToGhcException errs =
-   let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
-   in UsageError (renderWithStyle errors cmdlineParserStyle)
+    let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
+    in UsageError (renderWithStyle errors cmdlineParserStyle)