Initial commit. Three simple checks working.

.gitignore

@@ -0,0 +1,8 @@
+*~
+dist/
+*.tix
+.hpc
+*.prof
+*.hi
+*.o
+*.swp

hstyle.cabal

@@ -0,0 +1,35 @@
+name:           hstyle
+version:        0.1
+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
+                with other style guides.
+license:        BSD3
+author:         Doug Beardsley
+maintainer:     mightybyte@mightybyte.net
+build-type:     Simple
+cabal-version:  >= 1.6
+category:       Development
+
+extra-source-files:
+  README.md
+
+Executable hstyle
+  hs-source-dirs: src
+  main-is: Main.hs
+
+  build-depends:
+    base >= 4 && < 5,
+    haskell98,
+    text
+
+  if impl(ghc >= 6.12.0)
+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
+                 -fno-warn-orphans -fno-warn-unused-do-bind
+  else
+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
+                 -fno-warn-orphans
+
+source-repository head
+  type:     git
+  location: http://github.com/mightybyte/hstyle

src/Main.hs

@@ -0,0 +1,127 @@
+{-|
+
+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 where
+
+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'"
+