Lint using Haskell style scanner (scan)

.travis.yml

@@ -54,8 +54,10 @@ install:
 - 'sed -E "s/resolver\s*:\s*.*/resolver: $RESOLVER/" stack.yaml > stack-new.yaml'
 - mv stack-new.yaml stack.yaml
 - travis_long stack --no-terminal setup
+- travis_long stack --no-terminal install scan
 script:
 - source "$HOME/.pyvenv/bin/activate" && stack --no-terminal test
+- ./lint.sh
 before_deploy:
 - stack build --no-terminal --copy-bins
 - mkdir -p /tmp/nirum-build

README.md

@@ -72,7 +72,7 @@ Building
 If you already installed [Haskell Platform][5] or [Haskell Stack][6],
 you can build the project in the same way to build other Haskell projects.
 
-Using Stack:
+Using Haskell Stack:
 
     $ stack build
 
@@ -83,6 +83,12 @@ Using vanilla Cabal:
     $ cabal configure
     $ cabal build
 
+You can run the test suite of Nirum:
+
+    $ stack test  # using Hasekll Stack
+    $ cabal test  # using Haskell Platform
+    $ ./lint.sh   # run style lint as well
+
 [5]: https://www.haskell.org/platform/
 [6]: https://www.haskellstack.org/
 

lint.sh

@@ -0,0 +1,41 @@
+#!/usr/bin/env bash
+set -e
+
+function abspath {
+  cd "$1"
+  pwd
+}
+
+# Automatically install this script as a pre-commit hook
+if [[ -d .git/ && ! -f .git/hooks/pre-commit ]]; then
+  mkdir -p .git/hooks/
+  cat <<EOF > .git/hooks/pre-commit
+#!/usr/bin/env bash
+set -e
+$(abspath "$(dirname "$0")")/lint.sh
+EOF
+  chmod +x .git/hooks/pre-commit
+fi
+
+if [[ "$(which stack)" != "" ]] && stack --help | head -n1 | grep -qi haskell
+then
+  stack test hlint
+  if [[ "$(stack exec scan -- -v)" = "" ]]; then
+    stack install scan
+  fi
+  scan=(stack exec scan --)
+else
+  cabal test hlint
+  cabal install scan
+  scan=(scan)
+fi
+
+# Haskell style scanner doesn't provide proper exit code ---
+# it always exists with zero even if it found errors.
+scanout="$(mktemp)"
+find src test -name '*.hs' -print0 | \
+    xargs -0 "${scan[@]}" -j false -c false > "$scanout"
+cat "$scanout"
+if [[ "$(cat "$scanout")" != "" ]]; then
+  exit 1
+fi

nirum.cabal

@@ -125,6 +125,7 @@ test-suite spec
                ,       process                  >=1.1     && <2
                ,       semigroups
                ,       semver                   >=0.3.0   && <1.0
+               ,       string-qq                >=0.0.2   && <0.1.0
                ,       temporary                >=1.2     && <1.3
                ,       text                     >=0.9.1.0 && <1.3
   ghc-options:         -Wall -Werror

src/Nirum/Cli.hs

@@ -2,7 +2,7 @@
 module Nirum.Cli (main, writeFiles) where
 
 import Control.Monad (forM_)
-import GHC.Exts (IsList(toList))
+import GHC.Exts (IsList (toList))
 import System.IO.Error (catchIOError, ioeGetErrorString)
 
 import qualified Data.Map.Strict as M
@@ -27,12 +27,12 @@ import System.FilePath (takeDirectory, (</>))
 import Text.InterpolatedString.Perl6 (qq)
 import Text.Megaparsec (Token)
 import Text.Megaparsec.Error ( Dec
-                             , ParseError(errorPos)
+                             , ParseError (errorPos)
                              , parseErrorPretty
                              )
-import Text.Megaparsec.Pos (SourcePos(sourceLine, sourceColumn), unPos)
+import Text.Megaparsec.Pos (SourcePos (sourceLine, sourceColumn), unPos)
 
-import Nirum.Constructs (Construct(toCode))
+import Nirum.Constructs (Construct (toCode))
 import Nirum.Constructs.Identifier (toText)
 import Nirum.Constructs.ModulePath (ModulePath)
 import Nirum.Package ( PackageError ( ImportError
@@ -136,8 +136,8 @@ main' = do
     scanResult <- scanPackage src
     case scanResult of
         Left (ParseError modulePath error') -> do
-            -- FIXME: find more efficient way to determine filename from
-            --        the given module path
+            {- FIXME: find more efficient way to determine filename from
+                      the given module path -}
             filePaths <- scanModules src
             case M.lookup modulePath filePaths of
                 Just filePath' -> do
@@ -154,7 +154,7 @@ main' = do
 
 writeFiles :: FilePath -> M.Map FilePath (Either T.Text T.Text) -> IO ()
 writeFiles obj m =
-    forM_ files $ \(filePath, result) ->
+    forM_ files $ \ (filePath, result) ->
         case result of
             Left compileError -> putStrLn [qq|error: $filePath: $compileError|]
             Right code -> do

src/Nirum/CodeGen.hs

@@ -7,7 +7,11 @@ module Nirum.CodeGen ( CodeGen
 
 import Control.Applicative (Applicative)
 import Control.Monad (Monad)
-import Control.Monad.Except (MonadError, ExceptT(ExceptT), mapExceptT, runExceptT)
+import Control.Monad.Except ( MonadError
+                            , ExceptT (ExceptT)
+                            , mapExceptT
+                            , runExceptT
+                            )
 import Control.Monad.State (MonadState, State, mapState, runState)
 import Data.Functor (Functor)
 
@@ -33,7 +37,7 @@ instance (Failure s e) => Monad (CodeGen s e) where
     {-# INLINE (>>=) #-}
     fail str = CodeGen $ mapExceptT mutate (fromString str)
       where
-        mutate = mapState (\(a, s) -> case a of
+        mutate = mapState (\ (a, s) -> case a of
                                           Left _ -> undefined
                                           Right e -> (Left e, s))
     {-# INLINE fail #-}

src/Nirum/Constructs/Annotation.hs

@@ -1,7 +1,7 @@
-module Nirum.Constructs.Annotation ( Annotation(Annotation)
+module Nirum.Constructs.Annotation ( Annotation (Annotation)
                                    , AnnotationSet
                                    , Metadata
-                                   , NameDuplication(AnnotationNameDuplication)
+                                   , NameDuplication (AnnotationNameDuplication)
                                    , annotations
                                    , docs
                                    , empty
@@ -53,9 +53,9 @@ fromList annotations' =
     findDup :: [Identifier] -> S.Set Identifier -> Maybe Identifier
     findDup identifiers dups =
         case identifiers of
-            x:xs -> if x `S.member` dups
-                    then Just x
-                    else findDup xs $ S.insert x dups
+            x : xs -> if x `S.member` dups
+                      then Just x
+                      else findDup xs $ S.insert x dups
             _ -> Nothing
 
 toList :: AnnotationSet -> [Annotation]
@@ -79,8 +79,8 @@ lookupDocs annotationSet = do
 insertDocs :: (Monad m) => Docs -> AnnotationSet -> m AnnotationSet
 insertDocs docs' (AnnotationSet anno) =
     case insertLookup annotationDocsName (Just $ toText docs') anno of
-        (Just _ , _    ) -> fail "<duplicated>"
+        (Just _ , _) -> fail "<duplicated>"
         (Nothing, anno') -> return $ AnnotationSet anno'
   where
     insertLookup :: Ord k => k -> a -> M.Map k a -> (Maybe a, M.Map k a)
-    insertLookup = M.insertLookupWithKey (\_ a _ -> a)
+    insertLookup = M.insertLookupWithKey $ \ _ a _ -> a

src/Nirum/Constructs/Annotation/Internal.hs

@@ -1,6 +1,11 @@
 {-# LANGUAGE QuasiQuotes #-}
-module Nirum.Constructs.Annotation.Internal ( Annotation(..)
-                                            , AnnotationSet(..)
+module Nirum.Constructs.Annotation.Internal ( Annotation ( Annotation
+                                                         , metadata
+                                                         , name
+                                                         )
+                                            , AnnotationSet ( AnnotationSet
+                                                            , annotations
+                                                            )
                                             , Metadata
                                             , fromTuple
                                             ) where
@@ -23,15 +28,16 @@ data Annotation = Annotation { name :: Identifier
                              } deriving (Eq, Ord, Show)
 
 instance Construct Annotation where
-    toCode Annotation {name = n,  metadata = Just m} = [qq|@{toCode n}("$m'")|]
+    toCode Annotation {name = n, metadata = Just m} =
+        [qq|@{toCode n}("$m'")|]
       where
         m' = (showLitString $ T.unpack m) ""
         showLitString :: String -> ShowS
         showLitString = foldr ((.) . showLitChar') id
         showLitChar' :: Char -> ShowS
         showLitChar' '"' = showString "\\\""
-        showLitChar' c   = C.showLitChar c
-    toCode Annotation {name = n,  metadata = Nothing} = [qq|@{toCode n}|]
+        showLitChar' c = C.showLitChar c
+    toCode Annotation {name = n, metadata = Nothing} = [qq|@{toCode n}|]
 
 fromTuple :: (Identifier, Maybe Metadata) -> Annotation
 fromTuple (name', meta') = Annotation { name = name', metadata = meta' }

src/Nirum/Constructs/Declaration.hs

@@ -11,7 +11,7 @@ import Nirum.Constructs.Name (Name)
 
 -- 'Construct' which has its own unique 'name' and can has its 'docs'.
 class Construct a => Declaration a where
-    name        :: a -> Name
+    name :: a -> Name
     annotations :: a -> AnnotationSet
 
 docs :: Declaration a => a -> Maybe Docs

src/Nirum/Constructs/DeclarationSet.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedLists, TypeFamilies #-}
-module Nirum.Constructs.DeclarationSet ( DeclarationSet()
-                                       , NameDuplication( BehindNameDuplication
-                                                        , FacialNameDuplication
-                                                        )
+module Nirum.Constructs.DeclarationSet ( DeclarationSet ()
+                                       , NameDuplication ( BehindNameDuplication
+                                                         , FacialNameDuplication
+                                                         )
                                        , empty
                                        , fromList
                                        , lookup
@@ -22,9 +22,9 @@ import Prelude hiding (lookup, null)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 
-import Nirum.Constructs.Declaration (Declaration(name))
+import Nirum.Constructs.Declaration (Declaration (name))
 import Nirum.Constructs.Identifier (Identifier)
-import Nirum.Constructs.Name (Name(Name, behindName, facialName))
+import Nirum.Constructs.Name (Name (Name, behindName, facialName))
 
 data Declaration a => DeclarationSet a
     -- | The set of 'Declaration' values.
@@ -62,10 +62,10 @@ fromList declarations' =
     findDup :: [Name] -> (Name -> Identifier) -> S.Set Identifier -> Maybe Name
     findDup names' f dups =
         case names' of
-            x:xs -> let name' = f x
-                    in if name' `S.member` dups
-                       then Just x
-                       else findDup xs f $ S.insert name' dups
+            x : xs -> let name' = f x
+                      in if name' `S.member` dups
+                         then Just x
+                         else findDup xs f $ S.insert name' dups
             _ -> Nothing
 
 toList :: Declaration a => DeclarationSet a -> [a]

src/Nirum/Constructs/Docs.hs

@@ -1,16 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Nirum.Constructs.Docs ( Docs(Docs)
+module Nirum.Constructs.Docs ( Docs (Docs)
                              , annotationDocsName
                              , toCode
                              , toCodeWithPrefix
                              , toText
                              ) where
 
-import Data.String (IsString(fromString))
+import Data.String (IsString (fromString))
 
 import qualified Data.Text as T
 
-import Nirum.Constructs (Construct(toCode))
+import Nirum.Constructs (Construct (toCode))
 import Nirum.Constructs.Identifier (Identifier)
 
 annotationDocsName :: Identifier
@@ -26,8 +26,8 @@ toText (Docs docs') = docs'
 -- | Similar to 'toCode' except it takes 'Maybe Docs' instead of 'Docs'.
 -- If the given docs is 'Nothing' it simply returns an empty string.
 -- Otherwise it returns a code string with the prefix.
-toCodeWithPrefix :: T.Text     -- | The prefix to be prepended if not empty.
-                 -> Maybe Docs -- | The docs to convert to code.
+toCodeWithPrefix :: T.Text     -- ^ The prefix to be prepended if not empty.
+                 -> Maybe Docs -- ^ The docs to convert to code.
                  -> T.Text
 toCodeWithPrefix _ Nothing = ""
 toCodeWithPrefix prefix (Just docs') = T.append prefix $ toCode docs'

src/Nirum/Constructs/Identifier.hs

@@ -21,34 +21,36 @@ module Nirum.Constructs.Identifier ( Identifier
 
 import Data.Char (toLower, toUpper)
 import Data.Maybe (fromMaybe)
-import Data.String (IsString(fromString))
+import Data.String (IsString (fromString))
 
 import qualified Data.Text as T
 import qualified Data.Set as S
 import qualified Text.Megaparsec as P
 import Text.Megaparsec.Char (oneOf, satisfy)
 import Text.Megaparsec.Text (Parser)
 
-import Nirum.Constructs (Construct(toCode))
-
--- | Case-insensitive identifier.  It also doesn't distinguish hyphens
--- from underscores.
---
--- It has more restrict rules than the most of programming languages:
---
--- * It can't start with digits or hyphens/underscores.
--- * Hyphens/underscores can't continuously appear more than once.
--- * Only roman alphabets, Arabic numerals, hyphens and underscores
---   are allowed.
--- 
--- These rules are for portability between various programming languages.
--- For example, @BOOK_CATEGORY@ and @Book-Category@ are all normalized
--- to @book-category@, and it can be translated to:
--- 
--- [snake_case] @book_category@
--- [camelCase] @bookCategory@
--- [PascalCase] @BookCategory@
--- [lisp-case] @book-category@
+import Nirum.Constructs (Construct (toCode))
+
+{- |
+Case-insensitive identifier.  It also doesn't distinguish hyphens
+from underscores.
+
+It has more restrict rules than the most of programming languages:
+
+* It can't start with digits or hyphens/underscores.
+* Hyphens/underscores can't continuously appear more than once.
+* Only roman alphabets, Arabic numerals, hyphens and underscores
+  are allowed.
+
+These rules are for portability between various programming languages.
+For example, @BOOK_CATEGORY@ and @Book-Category@ are all normalized
+to @book-category@, and it can be translated to:
+
+[snake_case] @book_category@
+[camelCase] @bookCategory@
+[PascalCase] @BookCategory@
+[lisp-case] @book-category@
+-}
 data Identifier = Identifier T.Text deriving (Show)
 
 reservedKeywords :: S.Set Identifier
@@ -68,7 +70,7 @@ identifierRule = do
     restWords <- P.many $ do
         sep <- oneOf ("-_" :: String)
         chars <- P.some $ satisfy isAlnum
-        return $ T.pack $ sep:chars
+        return $ T.pack $ sep : chars
     return $ Identifier $ T.concat $ T.pack (firstChar : restChars) : restWords
   where
     isAlpha :: Char -> Bool
@@ -78,7 +80,7 @@ identifierRule = do
     isAlnum :: Char -> Bool
     isAlnum c = isAlpha c || isDigit c
 
--- | Constructs a 'Identifier' value from the given identifier string.
+-- | Constructs an 'Identifier' value from the given identifier string.
 -- It could return 'Nothing' if the given identifier is invalid.
 fromText :: T.Text -> Maybe Identifier
 fromText text =
@@ -94,7 +96,7 @@ fromText text =
 
 normalize :: Identifier -> Identifier
 normalize (Identifier i) =
-    Identifier $ T.map (\c -> if c == '_' then '-' else toLower c) i
+    Identifier $ T.map (\ c -> if c == '_' then '-' else toLower c) i
 
 toText :: Identifier -> T.Text
 toText (Identifier text) = text