diff --git a/scan.cabal b/scan.cabal
--- a/scan.cabal
+++ b/scan.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.6
 build-type:         Simple
 name:               scan
-version:            0.1.0.0
+version:            0.1.0.1
 license:            BSD3
 license-file:       doc/LICENSE
 category:           Development
@@ -10,31 +10,8 @@
 copyright:          Christian Maeder 2010
 synopsis:           lexical style suggestions for source code
 description:
-  scan checks the format of your source code. It reports
-  (and partly repairs if given the @-@ option):
-
-  non-ascii characters,
-  tabs or carriage returns,
-  trailing white spaces,
-  backslash at line end,
-  unconventional comment delimiters,
-  too long lines,
-  too many consecutive blank lines,
-  not a single blank between tokens,
-  not a single final newline,
-  no spaces after commas,
-  spaces between parens and infix operators in sections,
-  bad layout (wrt @do@ or @of@).
-
-  It may be useful in conjunction with
-  <http://community.haskell.org/~ndm/hlint/>
-  to give suggestions on how to improve your source code.
-
-  Repairing is not suited for slices (aka @$(...)@) in template haskell or if
-  you like to align your code at @=@ or @->@ in the middle of a line (thus
-  wanting multiple blanks). Furthermore layout may be destroyed by inserting
-  or deleting blanks, but this is an indication for improving layout anyway.
-  Also lines may become too long after inserting blanks.
+  scan checks the format of your haskell source code regarding:
+  comments, white spaces and line breaks.
 
 homepage:           http://projects.haskell.org/style-scanner
 stability:          experimental
@@ -43,5 +20,6 @@
     build-depends:      base < 5, parsec < 3 || >= 3
     hs-source-dirs:     src
     main-is:            scan.hs
+    other-modules:      Language.Haskell.Scanner
 
     ghc-options: -Wall
diff --git a/src/Language/Haskell/Scanner.hs b/src/Language/Haskell/Scanner.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Scanner.hs
@@ -0,0 +1,508 @@
+{- |
+Module      :  $Header$
+Description :  scan tokens of Haskell sources
+Copyright   :  (c) C. Maeder 2010
+License     :  BSD
+
+Maintainer  :  chr.maeder@web.de
+Stability   :  provisional
+Portability :  portable
+
+using parsec as scanner to tokenize haskell sources
+and check the spacing
+
+-}
+
+module Language.Haskell.Scanner
+  ( splitLines
+  , showScan
+  , processScan
+  , scan
+  , PosTok
+  ) where
+
+import Control.Monad
+
+import Data.Char
+import Data.List
+
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Pos
+
+-- * monad shortcuts
+
+infixl 1 <<
+
+(<<) :: Monad m => m a -> m b -> m a
+(<<) = liftM2 const
+
+infixr 5 <:>
+
+(<:>) :: Monad m => m a -> m [a] -> m [a]
+(<:>) = liftM2 (:)
+
+infixr 5 <++>
+
+(<++>) :: Monad m => m [a] -> m [a] -> m [a]
+(<++>) = liftM2 (++)
+
+single :: Monad m => m a -> m [a]
+single = liftM return
+
+flat :: Monad m => m [[a]] -> m [a]
+flat = liftM concat
+
+enclosedBy :: Monad m => m [a] -> m a -> m [a]
+enclosedBy p q = q <:> p <++> single q
+
+-- * parsec shortcuts
+
+-- | parse an optional list
+optionL :: GenParser tok st [a] -> GenParser tok st [a]
+optionL = option []
+
+-- | shortcut for @try . string@
+tryString :: String -> CharParser st String
+tryString = try . string
+
+-- | nested comments, open and closing strings must have at least two chars
+nestedComment :: String -> String -> CharParser st String
+nestedComment op cl = case (op, cl) of
+  (oh : ot : _, ch : ct : _) ->
+    tryString op <++>
+    flat (many $ single
+          (noneOf [oh, ch]
+           <|> try (char ch << notFollowedBy (char ct))
+           <|> try (char oh << notFollowedBy (char ot)) <?> "")
+          <|> nestedComment op cl)
+    <++> string cl
+  _ -> error "nestedComment"
+
+-- * haskell tokens
+
+-- | the haskell nested comments
+nestComment :: CharParser st String
+nestComment = nestedComment "{-" "-}"
+
+-- | line comment without final newline
+lineComment :: CharParser st String
+lineComment =
+  try ((char '-' <:> many1 (char '-'))
+       << notFollowedBy (oneOf "!#$%&*+./<=>?@\\^|~"))
+  <++> many (noneOf "\n")
+
+-- | text in double quotes
+stringLit :: CharParser st String
+stringLit = enclosedBy (flat $ many $ single (noneOf "\\\"")
+                        <|> char '\\' <:> single anyChar) $ char '\"'
+
+-- | text in single quotes
+charLit :: CharParser st String
+charLit = tryString "'''" <|>
+          enclosedBy (flat $ many $ single (noneOf "\\\'")
+                      <|> char '\\' <:> single anyChar)
+          (char '\'')
+
+-- | a precise number scanner
+number :: Parser String
+number =
+    try (char '0' <:> single (oneOf "oO")) <++> many octDigit
+  <|>
+    try (char '0' <:> single (oneOf "xX")) <++> many hexDigit
+  <|> many1 digit
+          <++> optionL (try (char '.' <:> single digit) <++> many digit)
+          <++> optionL (try (oneOf "eE" <:> optionL (single $ oneOf "+-")
+                             <++> single digit) <++> many digit)
+
+-- | any character within identifiers
+hChar :: Parser Char
+hChar = alphaNum <|> oneOf "_'"
+
+-- | the underscore parser
+uL :: Parser Char
+uL = char '_'
+
+-- | lower case identifiers (aka variables)
+lId :: Parser String
+lId = (uL <|> lower) <:> many hChar
+
+-- | upper case identifiers (aka constructors)
+uId :: Parser String
+uId = upper <:> many hChar
+
+-- | any character within operators
+opSym :: Parser Char
+opSym = oneOf "!#$%&*+-./:<=>?@\\^|~"
+
+-- | any operator (mainly infixes)
+operator :: Parser String
+operator = many1 opSym
+
+-- | possible qualified entities: lower or upper case words or symbols
+data QualElem = Var | Cons | Sym deriving Eq
+
+-- | a name qualified or not with its representation
+data QualName = Name Bool QualElem String
+
+-- | the show instance renders the original string
+instance Show QualName where
+  show (Name _ _ s) = s
+
+-- | any qualified or unqualified name or operator
+qId :: Parser QualName
+qId = fmap (Name False Var) lId
+  <|> fmap (Name False Sym) operator
+  <|> do
+    n <- uId
+    option (Name False Cons n) $ do
+      d <- try (char '.' << lookAhead (uL <|> letter <|> opSym))
+      Name _ k r <- qId
+      return $ Name True k $ n ++ d : r
+
+-- | parse any 'qId' within back ticks. This is more liberal than haskell!
+infixOp :: Parser String
+infixOp = enclosedBy (fmap show qId) $ char '`'
+
+-- | the separators are comma, semicolon and various kinds of parens
+seps :: String
+seps = "[({,;})]\n"
+
+-- | beside names and separators we have a couple of more token kinds
+data TokenKind = LineComment | BlockComment | Literal | Infix
+
+-- | the data type for tokens
+data Token
+  = QualName QualName
+  | Sep Char
+  | Token TokenKind String
+  | Start -- ^ the void token at the very beginning
+
+-- | the show instance renders the original string without kind information
+instance Show Token where
+  show t = case t of
+    QualName q -> show q
+    Sep c -> [c]
+    Token _ s -> s
+    Start -> ""
+
+-- | all white spaces except newline
+isWhite :: Char -> Bool
+isWhite c = isSpace c && c /= '\n'
+
+-- | parsing as many 'isWhite' characters as possible (or none)
+white :: Parser String
+white = many $ satisfy isWhite
+
+-- | parse any non-white token
+tok :: Parser Token
+tok = fmap (Token BlockComment) nestComment
+  <|> fmap (Token LineComment) lineComment
+  <|> fmap QualName qId
+  <|> fmap Sep (oneOf seps)
+  <|> fmap (Token Literal) (charLit <|> stringLit <|> number)
+  <|> fmap (Token Infix) infixOp
+
+-- | tokens enriched by positions and following white space
+data PosTok = PosTok SourcePos Token String
+
+instance Show PosTok where
+  show (PosTok _ t s) = shows t s
+
+-- | attach positions and subsequent 'white' spaces to tokens
+posTok :: Parser PosTok
+posTok = do
+  p <- getPosition
+  t <- tok
+  w <- white
+  return $ PosTok p t w
+
+-- | the start position (without file name)
+startPos :: SourcePos
+startPos = initialPos ""
+
+-- | the initial 'white' stuff
+startTok :: Parser PosTok
+startTok = fmap (PosTok startPos Start) white
+
+-- | the final scanner
+scan :: Parser [PosTok]
+scan = startTok <:> many posTok << eof
+
+-- * splitting lines
+
+{- | a generic splitting function that keeps the separator as first element
+except in the first list. -}
+splitBy :: (a -> Bool) -> [a] -> [[a]]
+splitBy p l = let (fr, rt) = break p l in fr : case rt of
+  [] -> []
+  d : tl -> let hd : tll = splitBy p tl in (d : hd) : tll
+
+-- | split lines at newline tokens
+splitLines :: [PosTok] -> [[PosTok]]
+splitLines = splitBy isIndent
+
+-- | removing more than two consecutive lists fulfilling the predicate
+removeBlankLines :: Int -> ([a] -> Bool) -> [[a]] -> [[a]]
+removeBlankLines c p l = case l of
+  [] -> []
+  x : r ->
+    if p x
+    then if c > 1
+         then removeBlankLines c p r
+         else x : removeBlankLines (c + 1) p r
+    else x : removeBlankLines 0 p r
+
+-- * message data type
+
+-- | messages with positions
+data Diag = Diag SourcePos String
+
+instance Show Diag where
+  show (Diag p s) = show p ++ ' ' : s
+
+-- * checking tokens
+
+-- | only show the token without spaces
+showTok :: PosTok -> String
+showTok (PosTok _ t _) = show t
+
+isInfixOp :: PosTok -> Bool
+isInfixOp (PosTok _ t _) = case t of
+  QualName (Name _ Sym s) -> notElem s $ map (: []) "!#@\\~"
+  Token Infix _ -> True
+  _ -> False
+
+isComment :: PosTok -> Bool
+isComment (PosTok _ t _) = case t of
+  Token k _ -> case k of
+    LineComment -> True
+    BlockComment -> True
+    _ -> False
+  _ -> False
+
+noLineComment :: PosTok -> Bool
+noLineComment (PosTok _ t _) = case t of
+  Token LineComment _ -> False
+  _ -> True
+
+isSepIn :: String -> PosTok -> Bool
+isSepIn cs (PosTok _ t _) = case t of
+  Sep c -> elem c cs
+  _ -> False
+
+isIndent :: PosTok -> Bool
+isIndent = isSepIn "\n"
+
+isOpPar :: PosTok -> Bool
+isOpPar = isSepIn "[({"
+
+isClPar :: PosTok -> Bool
+isClPar = isSepIn "})]"
+
+isOpParOrInfix :: PosTok -> Bool
+isOpParOrInfix t = isOpPar t || isInfixOp t
+
+isClParOrInfix :: PosTok -> Bool
+isClParOrInfix t = isClPar t || isInfixOp t
+
+isNonPar :: PosTok -> Bool
+isNonPar = isSepIn ",;"
+
+isFstInfixMinusArg :: PosTok -> Bool
+isFstInfixMinusArg t@(PosTok _ u _) = case u of
+  QualName (Name _ k _) -> k /= Sym
+  Sep _ -> isClPar t
+  Token k _ -> case k of
+    Literal -> True
+    Infix -> True
+    _ -> False
+  Start -> False
+
+noSpaceNeededBefore :: PosTok -> Bool
+noSpaceNeededBefore t =
+  isSepIn ",;})]" t || showTok t == "@"
+
+noSpaceNeededAfter :: PosTok -> Bool
+noSpaceNeededAfter t@(PosTok _ u _) =
+  isOpPar t || elem (show u) (map (: []) "!#-@~")
+
+-- * adjusting tokens
+
+-- | replace all white spaces by blanks
+untabify :: SourcePos -> String -> String
+untabify p s =
+  let p2 = updatePosString p s
+      bs = sourceColumn p2 - sourceColumn p
+  in replicate bs ' '
+
+untab :: PosTok -> PosTok
+untab (PosTok p t w) = PosTok p t $ untabify (updatePosString p $ show t) w
+
+-- | remove trailing spaces
+rmSp :: PosTok -> PosTok
+rmSp (PosTok p t _) = PosTok p t ""
+
+-- | append exactly one blank
+blank :: PosTok -> PosTok
+blank (PosTok p t _) = PosTok p t " "
+
+multipleBlanks :: PosTok -> [Diag]
+multipleBlanks (PosTok p t w) = let n = length w in
+  [ Diag (updatePosString p $ show t) $ "multiple (" ++ show n ++ ") blanks"
+  | n > 1 ]
+
+-- | tidy up line comments
+adjustLineComment :: String -> String
+adjustLineComment = ("--" ++)
+  . reverse . dropWhile isSpace . reverse
+  . (' ' :) . dropWhile isSpace . drop 2 -- cut of initial line comment marker
+
+-- | check if prefix extended by one char from next string is still a prefix
+hasLongerPrefix :: String -> String -> String -> Bool
+hasLongerPrefix p n s = let ps = map (\ c -> p ++ [c]) n in
+  any (`isPrefixOf` s) ps
+
+-- | insert a single blank after prefix
+adjustPrefix :: String -> String -> String -> String
+adjustPrefix p n s =
+   if hasLongerPrefix p n s then s else case stripPrefix p s of
+     Nothing -> s
+     Just r -> p ++ case dropWhile isWhite r of
+         rt@('\n' : _) -> case s of
+           '}' : _ -> r
+           _ -> rt
+         rt -> ' ' : rt
+
+-- | adjust comment at both ends. Input is prefix, suffix and extension chars.
+adjustBothEnds :: String -> String -> String -> String -> String
+adjustBothEnds p q n s =
+    if hasLongerPrefix p n s then s else
+    concatMap (reverse . dropWhile isWhite . reverse)
+    $ removeBlankLines 0 (all isSpace)
+    $ splitBy (== '\n')
+    $ reverse $ adjustPrefix (reverse q) n $ reverse $ adjustPrefix p n s
+
+-- | adjust a block comment
+adjustComment :: String -> String
+adjustComment = adjustBothEnds "{-" "-}" "!#"
+    . adjustBothEnds "{-!" "!-}" ""
+    . adjustBothEnds "{-#" "#-}" ""
+
+-- * analyse and adjust lines
+
+-- | utility to combine results
+(<+>) :: (PosTok, [Diag]) -> ([PosTok], [Diag]) -> ([PosTok], [Diag])
+(t, ds) <+> (ts, es) = (t : ts, ds ++ es)
+
+infixr 4 <+>
+
+anaPosTok :: PosTok -> (PosTok, [Diag])
+anaPosTok t@(PosTok p u w) = case u of
+  Token BlockComment s -> let
+    n = adjustComment s
+    s5 = take 5 s
+    nr = take 5 $ reverse n
+    sr = take 5 $ reverse s
+    in (PosTok p (Token BlockComment n) w,
+       [ Diag p $ "non-conventional comment start: " ++ s5 | s5 /= take 5 n ]
+       ++ [ Diag (updatePosString p s) $ "non-conventional comment end: "
+            ++ reverse sr | sr /= nr ])
+  _ | show u == ";" -> (t, [Diag p "use layout instead of ;"])
+  _ -> (t, [])
+
+anaLine :: [PosTok] -> ([PosTok], [Diag])
+anaLine l = case l of
+  [] -> ([], [])
+  t0 : r1 -> let (t1@(PosTok p1 u1 w1), cs) = anaPosTok t0 in case r1 of
+    [] -> case u1 of
+      Token LineComment s -> let
+        n = adjustLineComment s
+        s4 = take 4 s
+        in ([PosTok p1 (Token LineComment n) ""], cs ++
+           [Diag p1 $ "leave a single blank after line comment sign: " ++ s4
+           | s4 /= take 4 n])
+      _ -> ([rmSp t1], cs ++ [Diag p1 "trailing white space" | not (null w1)])
+    t2@(PosTok p2 u2 w2) : r2 -> case u1 of
+      Start -> (rmSp t1, cs ++ [Diag p1 "leading white space" | not (null w1)])
+        <+> anaLine r1
+      _ | isIndent t1 -> let (ft, rt) = span (== ' ') w1 in
+           (untab t1, cs ++
+           [ Diag (updatePosString p1 ft) "use only blanks for indentation"
+           | not (null rt) ]) <+> anaLine r1
+      _ -> let
+        s1 = show u1
+        s2 = show u2
+        n1 = length s1
+        n2 = length s2
+        lt = n1 <= n2
+        both = s1 ++ s2
+        after = case () of
+          _ | isNonPar t1 -> True
+            | isOpPar t2 -> False
+            | s1 == "\\" -> True
+            | isInfixOp t1 -> if isInfixOp t2 then lt else True
+            | isInfixOp t2 || s2 == ".." -> False
+          _ -> lt
+        parsOfBoth = filter (`elem` "[({})]") both
+        pos = case both of
+             _ : _ : _ -> "between"
+             _ | isOpPar t1 -> "after"
+               | isClPar t2 -> "before"
+             _ -> "here"
+        omitSpace = isOpParOrInfix t1 && isClParOrInfix t2
+          && not (isInfixOp t1 && isInfixOp t2)
+          && (s1 /= ".." || s2 /= "]")
+        addSpace = not (noSpaceNeededAfter t1)
+          && not (noSpaceNeededBefore t2)
+        (newT1, ds) =
+          if null w1
+          then if addSpace
+            then (blank t1, Diag p2
+                  ("leave space " ++
+                   if after then "after " ++ s1 else "before " ++ s2)
+               : [ Diag p1 "but may be template haskell splice $("
+                 | both == "$(" ])
+            else (t1, [])
+          else if omitSpace
+            then (rmSp t1,
+               [Diag p2 $ " no space needed " ++ pos ++ " " ++ parsOfBoth])
+            else if isComment t2
+              then (untab t1, [])
+              else (blank t1, multipleBlanks t1)
+        pt0 = (newT1, cs ++ ds)
+        in case r2 of
+          [] -> pt0 <+> anaLine r1
+          t3@(PosTok _ u3 _) : _ -> let
+            s3 = show u3
+            ms = [Diag p2 "put spaces around infix -" | null w1 || null w2 ]
+                 ++ multipleBlanks t1 ++ multipleBlanks t2
+            in if s2 == "-" && not (noSpaceNeededBefore t3)
+                  && isFstInfixMinusArg t1
+               then (blank t1, cs ++ ms) <+> anaLine (blank t2 : r2)
+               else (if elem s2 ["do", "of"] && s3 /= "{" && noLineComment t3
+                 then (newT1,
+                   cs ++ Diag p2 ("break line after " ++ show s2) : ds)
+                 else pt0) <+> anaLine r1
+
+-- * ensure final newline
+
+isBlankLine :: [PosTok] -> Bool
+isBlankLine x = case x of
+  [PosTok _ Start _] -> True
+  [t] -> isIndent t
+  _ -> False
+
+removeFinalBlankLines :: [[PosTok]] -> [[PosTok]]
+removeFinalBlankLines ll = reverse $ [PosTok startPos (Sep '\n') ""]
+  : dropWhile isBlankLine (reverse ll)
+
+-- * main functions
+
+-- | create adjusted source file
+processScan :: [[PosTok]] -> String
+processScan = concatMap (concatMap show . fst . anaLine)
+  . removeBlankLines 1 isBlankLine . removeFinalBlankLines
+
+-- | list all diagnostics
+showScan :: [[PosTok]] -> String
+showScan = intercalate "\n" . concatMap (map show . snd . anaLine)
diff --git a/src/scan.hs b/src/scan.hs
--- a/src/scan.hs
+++ b/src/scan.hs
@@ -54,7 +54,7 @@
 
 checkBlankLines :: FilePath -> Int -> [(Int, String)] -> [String]
 checkBlankLines f c l = case l of
-  [] -> if c > 0 then ["trailing blank lines"] else []
+  [] -> ["trailing blank lines" | c > 0]
   (n, s) : r ->
     if null $ filter (not . isSpace) s then
       if c >= 2 then