diff --git a/scan.cabal b/scan.cabal
--- a/scan.cabal
+++ b/scan.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.4
 build-type:         Simple
 name:               scan
-version:            0.1.0.7
+version:            0.1.0.8
 license:            BSD3
 license-file:       doc/LICENSE
 category:           Development
diff --git a/src/Language/Haskell/Scanner.hs b/src/Language/Haskell/Scanner.hs
--- a/src/Language/Haskell/Scanner.hs
+++ b/src/Language/Haskell/Scanner.hs
@@ -62,7 +62,7 @@
 
 -- | a literal enclosed in quotes and a backslash as escape character
 quotedLit :: Char -> CharParser st String
-quotedLit q = enclosedBy (flat $ many $ single (noneOf $ '\\' : [q])
+quotedLit q = enclosedBy (flat $ many $ single (noneOf ['\\', q])
                         <|> char '\\' <:> single anyChar) $ char q
 
 -- | text in double quotes
@@ -79,18 +79,12 @@
 tryString :: String -> CharParser st String
 tryString = try . string
 
--- | nested comments, open and closing strings must have at least two chars
+-- | nested comments, open and closing strings must have at least one char
 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"
+nestedComment op cl =
+    let inComment = tryString cl
+           <|> (nestedComment op cl <|> single anyChar) <++> inComment
+    in tryString op <++> inComment
 
 -- * haskell tokens
 
@@ -151,9 +145,12 @@
 showQualName :: QualName -> String
 showQualName (Name _ _ s) = s
 
+isLetterOrUnderscore :: Char -> Bool
+isLetterOrUnderscore c = c == '_' || isLetter c
+
 -- | the possible characters starting a name
 qIdStart :: Parser Char
-qIdStart = satisfy $ \ c -> c == '_' || isLetter c || opSym c
+qIdStart = satisfy $ \ c -> isLetterOrUnderscore c || opSym c
 
 -- | any quoted, qualified, or unqualified name or operator
 qId :: Parser QualName
@@ -167,7 +164,7 @@
       return $ Name True k $ n ++ d : r
   <|> do
     let noCh = notFollowedBy (char '\'')
-    s <- try (string "'" << lookAhead (letter << noCh)) -- limited recognition
+    s <- try (string "'" << lookAhead (satisfy isLetterOrUnderscore >> noCh))
       <|> try (string "''" << noCh)
     Name b k r <- qId
     return $ Name b k $ s ++ r
@@ -188,6 +185,8 @@
   | Infix        -- ^ something in back quotes
   | Sep          -- ^ a separator
   | Indent       -- ^ a newline or nothing at the very beginning
+  | QuasiQuote   -- ^ a quasi-quote
+  | ThQuote      -- ^ a possible template haskell quotation
 
 -- | the data type for tokens
 data Token
@@ -214,10 +213,21 @@
   charLit <++> optH
   <|> (stringLit <|> number) <++> optionL (char '#' <:> optH)
 
+-- | the template haskell quasi-quotes
+quasiQuote :: Parser Token
+quasiQuote = try $ do
+  q <- char '[' >> lId << char '|'
+  let start = '[' : q ++ "|"
+      -- check for plain TH quotation
+  if elem q $ single "dept" then return $ Token ThQuote start else
+    fmap (Token QuasiQuote . (start ++) . (++ "|]"))
+             $ manyTill anyChar $ tryString "|]"
+
 -- | parse any non-white token
 tok :: Parser Token
 tok = fmap (Token BlockComment) nestComment
   <|> fmap (Token LineComment) lineComment
+  <|> quasiQuote
   <|> fmap QualName qId
   <|> fmap (Token Sep) (single $ oneOf seps)
   <|> fmap (Token Indent) (string "\n")
@@ -332,8 +342,8 @@
 rmSp (PosTok p t _) = PosTok p t ""
 
 topKeys :: [String]
-topKeys = ["import", "data", "newtype", "type", "class", "instance"]
--- "module" may occur in export lists!
+topKeys = ["import", "data", "newtype", "class", "instance"]
+-- "module" may occur in export lists, "type" within type families!
 
 layoutKeys :: [String]
 layoutKeys = ["do", "of", "where"]
@@ -358,11 +368,17 @@
       -> (bTok, [diag | n > 1])
     _ -> (PosTok p t $ take m w, [diag | n > m])
 
+-- | cut of initial line comment marker and spaces
+trim2 :: String -> String
+trim2 = dropWhile isSpace . drop 2
+
+-- | add two dashes to a string plus a space for a non-emtpy string
+addLineCommentMark :: String -> String
+addLineCommentMark r = "--" ++ if null r then r else ' ' : r
+
 -- | tidy up line comments
 adjustLineComment :: String -> String
-adjustLineComment s = -- cut of initial line comment marker and spaces
-  let r = dropWhile isSpace $ drop 2 s in
-  "--" ++ if null r then r else ' ' : r
+adjustLineComment = addLineCommentMark . trim2
 
 -- | check if prefix extended by one char from next string is still a prefix
 hasLongerPrefix :: String -> String -> String -> Bool
@@ -394,9 +410,10 @@
 
 -- * analyse and adjust lines
 
-anaPosTok :: PosTok -> (PosTok, [Diag])
-anaPosTok t@(PosTok p u w) = case u of
-  Token BlockComment s -> let
+anaPosTok :: Opts -> PosTok -> (PosTok, [Diag])
+anaPosTok opts t@(PosTok p u w) =
+  let cC = checkComments opts in case u of
+  Token BlockComment s | cC -> let
     n = adjustComment s
     s5 = take 5 s
     nr = take 5 $ reverse n
@@ -406,7 +423,7 @@
        ++ [ Diag p "avoid nested comments" | isInfixOf "{-" $ drop 2 s ]
        ++ [ Diag (updatePosString p s) $ "non-conventional comment end: "
             ++ reverse sr | sr /= nr ])
-  Token LineComment s -> let
+  Token LineComment s | cC -> let
     n = adjustLineComment s
     s4 = take 4 s
     sr = takeWhile isPrint $ dropWhile isSpace $ drop 2 s4
@@ -421,22 +438,29 @@
              | isInfixOf "{-" n ]
         ++ [ Diag q "line comment contains block comment end"
              | isInfixOf "-}" n ])
+  Token ThQuote s | not $ tempHask opts -> let
+    (f, r) = splitAt 2 s
+    in (PosTok p (Token ThQuote $ f ++ " |") w,
+          [ Diag (updatePosString p f) $ "put blank between " ++ f ++ " and |"
+          | r == "|" ])
   _ -> (t, [ Diag p "use layout instead of ;" | isSepIn ";" u ])
 
 -- | a comment string that is no pragma or directive
 isNormalCommentString :: String -> Bool
-isNormalCommentString s = elem (drop 2 $ take 3 s) [" ", "\n"]
+isNormalCommentString s = case drop 2 s of
+  c : _ -> notElem c "!#"
+  _ -> True
 
 -- | a comment that is no pragma or directive
-isNormalComment :: PosTok -> Bool
-isNormalComment p@(PosTok _ u _) =
-  isComment u && isNormalCommentString (showPosTok $ fst $ anaPosTok p)
+isNormalComment :: Token -> Bool
+isNormalComment u =
+  isComment u && isNormalCommentString (showToken u)
 
 -- | check if no other normal comment follows
 noOtherComment :: [PosTok] -> Bool
 noOtherComment ps = case ps of
   [] -> True
-  p : _ -> not $ isNormalComment p
+  PosTok _ u _ : _ -> not $ isNormalComment u
 
 -- | the data type for options passed to the analysis
 data Opts = Opts
@@ -449,7 +473,7 @@
   , noMultBlanksAfter :: Token -> Bool
   , makeLineComments :: Bool
   , joinComments :: Bool
-  , ignoreComments :: Bool
+  , checkComments :: Bool
   , commentGap :: Int
   , checkSpacing :: Bool
   }
@@ -466,18 +490,17 @@
   , noMultBlanksAfter = isKeyw $ "let" : layoutKeys
   , makeLineComments = True
   , joinComments = True
-  , ignoreComments = False
+  , checkComments = True
   , commentGap = 0
   , checkSpacing = True
   }
 
 -- | analyse consecutive tokens
 anaPosToks :: Opts -> [PosTok] -> ([PosTok], [Diag])
-anaPosToks opts l = let ignoreC = ignoreComments opts in case l of
+anaPosToks opts l = case l of
   [] -> ([], [])
   t0 : r1 ->
-    let (tC@(PosTok p1 u1 w1), cC) = anaPosTok t0
-        (t1, cs) = if ignoreC then (t0, []) else (tC, cC)
+    let (t1@(PosTok p1 u1 w1), cs) = anaPosTok opts t0
     in case r1 of
     [] -> ([t1], cs)
     t2@(PosTok p2 u2 w2) : r2 -> let
@@ -516,31 +539,37 @@
         omitSpace = checkS && o1 && (isInfixOp u2 || c2)
           || isInfixOp u1 && c2 && not (isSymb [".."] u1 && isSepIn "]" u2)
         addSpace = checkS && ni1 && nw1
-          && (not (o1 || isSymb (map (: []) "!#-@~") u1) || isComment u2)
+          && (not (o1 || isSymb (single "!#-@~") u1) || isComment u2)
           && spaceNeededBefore u2
           && if tempHask opts then not $ isSymb ["$"] u1 else True
-        s1C = take (length s1 - 3) s1
+        trim = reverse . trim2
+        s1C = trim $ trim s1
         in case r2 of
-      _ | makeLineComments opts && isComment u1 && isIndent u2
-          && noOtherComment r2 && isPrefixOf "{- " s1C
-          && not (any (== '\n') s1C)
-        -> ( PosTok p1 (Token LineComment $ "-- " ++ drop 3 s1C) "" : ar1
+      _ | makeLineComments opts && isNormalComment u1 && isIndent u2
+          && noOtherComment r2 && noLineComment u1
+          && notElem '\n' s1C
+        -> ( PosTok p1 (Token LineComment $ addLineCommentMark s1C) "" : ar1
            , cs ++ Diag p1 "could be a line comment" : rds)
-        | joinC && isNormalComment tC && isNormalComment t2
+        | joinC && isNormalComment u1 && isNormalComment u2
         -> (al, cs ++ Diag p2 "consecutive comments" : rds)
       t3@(PosTok _ u3 _) : r3
-        | joinC && isNormalComment tC && isIndent u2 && isNormalComment t3
-        -> let (PosTok p3 nu3 w3, cs3) = anaPosTok t3
-               (f3, h3) = splitAt 3 (showToken nu3)
+        | joinC && isNormalComment u1 && isIndent u2 && isNormalComment u3
+        -> let (PosTok p3 nu3 w3, cs3) = anaPosTok opts t3
+               su3 = showToken nu3
+               h3 = trim2 su3
+               f3 = take (length su3 - length h3) su3
                hh3 = head h3
-               isHaddockStart = not (null h3) && any (hh3 ==) "$*^|"
+               cC = checkComments opts
+               isHaddockStart = cC && not (null h3)
+                 && elem hh3 "$*^|"
                s3 = if isHaddockStart
                     then dropWhile isSpace
                       $ if hh3 == '*' then dropWhile (== '*') h3 else tail h3
-                    else h3
+                    else if cC then h3 else drop 2 su3
                nt3 = PosTok p1 (Token BlockComment
-                 $ (if noLineComment u1 then s1C
-                   else "{- " ++ drop 3 s1)
+                 $ (if noLineComment u1
+                    then reverse . dropWhile (== ' ') . drop 2 $ reverse s1
+                   else "{-" ++ drop 2 s1)
                    ++ w1 ++ s2 ++ w2 ++ replicate (commentGap opts) ' '
                    ++ if noLineComment nu3 then s3
                       else s3 ++ " -}") w3
@@ -550,7 +579,7 @@
                 : [ Diag (updatePosString p3 f3)
                      $ "unexpected haddock marker " ++ [hh3]
                      | isHaddockStart ]
-                ++ (if ignoreC then [] else cs3) ++ rds3)
+                ++ cs3 ++ rds3)
         | checkS && isFstInfixMinusArg u1 && isSymb ["-"] u2
           && spaceNeededBefore u3
         -> let (bt2, m2) = multipleBlanks opts u3 t2 in
diff --git a/src/scan.hs b/src/scan.hs
--- a/src/scan.hs
+++ b/src/scan.hs
@@ -35,7 +35,7 @@
 
 -- | the hard-coded version string.
 version :: String
-version = "scan-0.1.0.7 http://projects.haskell.org/style-scanner/"
+version = "scan-0.1.0.8 http://projects.haskell.org/style-scanner/"
 
 data Flag =
     Help
@@ -128,7 +128,7 @@
     else m { maxBlanks = n }
 
   CheckSpacing b -> m { checkSpacing = b }
-  CheckComments b -> m { ignoreComments = not b }
+  CheckComments b -> m { checkComments = b }
   MakeLineComments b -> m { makeLineComments = b }
   JoinComments b -> m { joinComments = b }
   CommentGap n -> m { commentGap = n }
@@ -236,9 +236,10 @@
 checkBlankLines f m c n l = let p = diagLinePos f n in case l of
   [] -> [Diag p $ "trailing (" ++ show c ++ ") blank lines" | c > 0]
   s : r -> let n1 = n + 1 in
-    if null $ filter (not . isSpace) s then checkBlankLines f m (c + 1) n1 r
-    else [ Diag p $ "too many (" ++ show c ++ ") consecutive blank lines"
+    if any (not . isSpace) s
+    then [ Diag p $ "too many (" ++ show c ++ ") consecutive blank lines"
          | c > m ] ++ checkBlankLines f m 0 n1 r
+    else checkBlankLines f m (c + 1) n1 r
 
 -- | removing more than two consecutive lists fulfilling the predicate
 removeBlankLines :: Int -> Int -> ([a] -> Bool) -> [[a]] -> [[a]]