Permalink
Browse files

Use cmdargs to parse options

  • Loading branch information...
1 parent 0f65b45 commit 99d2ecdf1cc0b94c2d0de055f5f33ffa14738532 @jaspervdj jaspervdj committed Oct 30, 2011
Showing with 35 additions and 19 deletions.
  1. +2 −1 hstyle.cabal
  2. +12 −10 src/HStyle.hs
  3. +21 −8 src/Main.hs
View
@@ -1,5 +1,5 @@
Name: hstyle
-Version: 0.2.0.1
+Version: 0.2.0.2
Synopsis: Checks Haskell source code for style compliance.
Description: Originally intended to automate style checking for the Snap
project. But the project should be general enough to work
@@ -31,6 +31,7 @@ Executable hstyle
Build-depends:
base >= 4 && < 5,
+ cmdargs >= 0.8 && < 0.9,
haskell-src-exts >= 1.11 && < 1.12,
text >= 0.11 && < 0.12,
vector >= 0.7 && < 0.8
View
@@ -5,7 +5,7 @@ module HStyle
) where
import Control.Applicative ((<$>))
-import Control.Monad (forM, forM_)
+import Control.Monad (forM, forM_, unless)
import Data.Char (isSpace)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
@@ -22,17 +22,19 @@ import HStyle.Checker
-- | A selector and a check...
type Rule = (Selector, Checker)
-runRule :: FilePath -> Block -> H.Module H.SrcSpanInfo -> Rule -> IO Bool
-runRule file block md (selector, check) = fmap and $
+runRule :: Bool -> FilePath -> Block -> H.Module H.SrcSpanInfo -> Rule
+ -> IO Bool
+runRule quiet file block md (selector, check) = fmap and $
forM (selector md block) $ \block' -> do
let problems = check block'
forM_ problems $ \(i, problem) -> do
let line = absoluteLineNumber i block'
T.putStrLn $ T.pack file `T.append` ":" `T.append`
T.pack (show line) `T.append` ": " `T.append` problem
- T.putStrLn ""
- T.putStr $ prettyBlock 4 block'
- T.putStrLn ""
+ unless quiet $ do
+ T.putStrLn ""
+ T.putStr $ prettyBlock 4 block'
+ T.putStrLn ""
return $ null problems
fromSrcSpanInfo :: H.SrcSpanInfo -> Block -> Block
@@ -79,18 +81,18 @@ unCPP = unlines . map unCpp' . lines
| "#" `isPrefixOf` x = ""
| otherwise = x
-checkStyle :: FilePath -> IO Bool
-checkStyle file = do
+checkStyle :: Bool -> FilePath -> IO Bool
+checkStyle quiet file = do
contents <- readFile file
- let block = fromText $ T.pack contents
+ let block = fromText $ T.pack contents
-- Determine the extensions used in the file, and update the parsing
-- mode based upon those
exts = fromMaybe [] $ H.readExtensions contents
mode = H.defaultParseMode {H.extensions = exts}
-- Special handling for CPP, haskell-src-exts can't deal with it
contents' = if H.CPP `elem` exts then unCPP contents else contents
case H.parseModuleWithMode mode contents' of
- H.ParseOk md -> and <$> mapM (runRule file block md)
+ H.ParseOk md -> and <$> mapM (runRule quiet file block md)
[ (typeSigSelector, typeSigCheck)
, (selectLines, tabsCheck)
, (selectLines, lineLengthCheck 78)
View
@@ -1,24 +1,37 @@
-- | This is a very simple project containing a few code style checks for use
-- in git hooks for the Snap Framework. Hopefully we'll get some more
-- sophisticated checks and automatic fixes implemented eventually.
+{-# LANGUAGE DeriveDataTypeable #-}
module Main
( main
) where
import Control.Applicative ((<$>))
-import System.Environment (getArgs)
import System.Exit (ExitCode (..), exitWith)
+import System.Console.CmdArgs
+
import HStyle
+-- | CmdArgs-enabled data-type
+data HStyle = HStyle
+ { fix :: Bool
+ , quiet :: Bool
+ , files :: [FilePath]
+ } deriving (Show, Data, Typeable)
+
+-- | CmdArgs configuration
+hstyle :: HStyle
+hstyle = HStyle
+ { fix = def &= help "Automatically fix (some) problems"
+ , quiet = def &= help "Print less output"
+ , files = def &= args
+ }
+
-- | Simple main that takes one command-line parameter of "check" or "fix" and
-- a list of files to be checked.
main :: IO ()
main = do
- args <- getArgs
- case args of
- "check" : files -> do
- ok <- and <$> mapM checkStyle files
- exitWith $ if ok then ExitSuccess else ExitFailure 1
- "fix" : files -> mapM_ fixStyle files
- _ -> error "Must specify 'check' or 'fix'"
+ config <- cmdArgs hstyle
+ ok <- and <$> mapM (checkStyle $ quiet config) (files config)
+ exitWith $ if ok then ExitSuccess else ExitFailure 1

0 comments on commit 99d2ecd

Please sign in to comment.