summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2011-10-28 17:38:05 (GMT)
committerhdiff <hdiff@luite.com>2011-10-28 17:38:05 (GMT)
commit0d0b8804aeb0d767de52d89abb7b0581fea87e9a (patch)
tree609d66216f3366e38e7e726316fe1e0d1029049a /src/Main.hs
parentd50ff970ec6f851e286b1868308bc8739c15d54d (diff)
version 0.2.0.10.2.0.1
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs133
1 files changed, 15 insertions, 118 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 5e0654f..4a8a4d3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,127 +1,24 @@
-{-|
+-- | 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.
+module Main
+ ( main
+ ) where
-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.
+import Control.Applicative ((<$>))
+import System.Environment (getArgs)
+import System.Exit (ExitCode (..), exitWith)
--}
-module Main where
+import HStyle
-import System
-
-import qualified Data.Text as T
-import qualified Data.Text.IO as TI
-import Data.Text (Text)
-
-
-------------------------------------------------------------------------------
--- | A check is a function that processes a Text and returns a Just String if
--- there is a problem.
-type Check = Text -> Maybe String
-
-
-------------------------------------------------------------------------------
--- | A problem consists of a line number and a string description.
-data Problem = Problem {
- probLine :: Int,
- probDescription :: String
-}
-
-
-------------------------------------------------------------------------------
--- Style checks
-------------------------------------------------------------------------------
-
-------------------------------------------------------------------------------
--- | Checks for trailing spaces on a line.
-trailingSpaces :: Check
-trailingSpaces line = if T.length (T.takeWhile (==' ') $ T.reverse line) == 0
- then Nothing
- else Just "Line has trailing spaces"
-
-
-------------------------------------------------------------------------------
--- | Checks for tab charcters anywhere on a line.
-noTabs :: Check
-noTabs line = fmap (const "Line contains tab(s).") $ T.find (=='\t') line
-
-
-------------------------------------------------------------------------------
--- | Ensures line length is 78 characters or less.
-lineLength :: Int -> Check
-lineLength n line =
- if T.length line <= n
- then Nothing
- else Just "Line too long"
-
-
-------------------------------------------------------------------------------
--- | Static list of line-oriented checks to use.
-lineChecks :: [Check]
-lineChecks = [lineLength 78, noTabs, trailingSpaces]
-
-
-------------------------------------------------------------------------------
--- Infrastructure
-------------------------------------------------------------------------------
-
-------------------------------------------------------------------------------
--- | Applies a list of checks to a list of lines. Returns a list of
--- 'Problem's.
-onLines :: [Check] -> [Text] -> [Problem]
-onLines fs thelines = concat $ map (go 1 thelines) fs
- where
- go _ [] _ = []
- go num (l:ls) f = case f l of
- Nothing -> go (num+1) ls f
- Just er -> (Problem num er) : go (num+1) ls f
-
-
-------------------------------------------------------------------------------
--- | Breaks a file into lines and runs all the checks on them.
-checkContents :: Text -> [Problem]
-checkContents c = lineChecks `onLines` (T.lines c)
-
-
-------------------------------------------------------------------------------
--- | Runs checks on the specified file.
-checkFile :: FilePath -> IO (FilePath, [Problem])
-checkFile f = do
- problems <- return . checkContents =<< TI.readFile f
- return (f,problems)
-
-
-------------------------------------------------------------------------------
--- | Checks the style of a list of files, prints the problems, and exits with
--- a return value appropriate for use in a git hook.
-checkStyle :: [FilePath] -> IO ()
-checkStyle fs = do
- results <- mapM checkFile fs
- mapM_ printResults results
- case results of
- [] -> exitWith ExitSuccess
- _ -> exitWith (ExitFailure 1)
- where
- printResults (f,ps) = mapM_ (printRes f) ps
- printRes f p = putStrLn $ f ++ " line " ++ (show $ probLine p) ++
- ": " ++ (probDescription p)
-
-
-------------------------------------------------------------------------------
--- | Placeholder for fixing style problems.
-fixStyle :: t -> a
-fixStyle _ = do
- error "Not implemented"
-
-
-------------------------------------------------------------------------------
-- | 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 -> checkStyle files
- "fix":files -> fixStyle files
- _ -> error "Must specify 'check' or 'fix'"
-
+ "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'"