summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDougBeardsley <>2010-12-14 00:19:29 (GMT)
committerLuite Stegeman <luite@luite.com>2010-12-14 00:19:29 (GMT)
commitd50ff970ec6f851e286b1868308bc8739c15d54d (patch)
treed19b47362ea24a712b3d851307058da690aa8432
version 0.10.1
-rw-r--r--LICENSE27
-rw-r--r--README.md6
-rw-r--r--Setup.hs3
-rw-r--r--hstyle.cabal36
-rw-r--r--src/Main.hs127
5 files changed, 199 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..245f321
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2010, Doug Beardsley
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright notice, this
+list of conditions and the following disclaimer in the documentation and/or
+other materials provided with the distribution.
+
+Neither the name of the author nor the names of its contributors may be used
+to endorse or promote products derived from this software without specific
+prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..60808fa
--- /dev/null
+++ b/README.md
@@ -0,0 +1,6 @@
+hstyle is a code style checker for Haskell programs. So far it's just a
+quick-and-dirty implementation of a few of the simplest requirements found in
+the [Snap Framework's Haskell Style
+Guide](http://snapframework.com/docs/style-guide). In the future we hope to
+build more sophisticated checking. The ultimate goal would be an automatic
+reformatter that generates gorgeous code--but that's a hard problem.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..e8ef27d
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/hstyle.cabal b/hstyle.cabal
new file mode 100644
index 0000000..283e520
--- /dev/null
+++ b/hstyle.cabal
@@ -0,0 +1,36 @@
+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
+license-file: LICENSE
+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
+ -fno-warn-orphans -fno-warn-unused-do-bind
+ else
+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
+ -fno-warn-orphans
+
+source-repository head
+ type: git
+ location: http://github.com/mightybyte/hstyle
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..5e0654f
--- /dev/null
+++ b/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'"
+