diff --git a/BENCHMARKS.md b/BENCHMARKS.md
--- a/BENCHMARKS.md
+++ b/BENCHMARKS.md
@@ -56,6 +56,61 @@
          -> Printer ()
 ```
 
+Bunch of declarations - sans comments
+
+``` haskell
+listPrinters =
+  [(''[]
+   ,\(typeVariable:_) _automaticPrinter ->
+      (let presentVar = varE (presentVarName typeVariable)
+       in lamE [varP (presentVarName typeVariable)]
+               [|(let typeString = "[" ++ fst $(presentVar) ++ "]"
+                  in (typeString
+                     ,\xs ->
+                        case fst $(presentVar) of
+                          "GHC.Types.Char" ->
+                            ChoicePresentation
+                              "String"
+                              [("String",undefined)
+                              ,("List of characters",undefined)]
+                          _ ->
+                            ListPresentation typeString
+                                             (map (snd $(presentVar)) xs)))|]))]
+printComments loc' ast = do
+  let correctLocation comment = comInfoLocation comment == Just loc'
+      commentsWithLocation = filter correctLocation (nodeInfoComments info)
+  comments <- return $ map comInfoComment commentsWithLocation
+
+  forM_ comments $ \comment -> do
+    hasNewline <- gets psNewline
+    when (not hasNewline && loc' == Before) newline
+
+    printComment (Just $ srcInfoSpan $ nodeInfoSpan info) comment
+  where info = ann ast
+exp' (App _ op a) =
+  do (fits,st) <-
+       fitsOnOneLine (spaced (map pretty (f : args)))
+     if fits
+        then put st
+        else do pretty f
+                newline
+                spaces <- getIndentSpaces
+                indented spaces (lined (map pretty args))
+  where (f,args) = flatten op [a]
+        flatten :: Exp NodeInfo
+                -> [Exp NodeInfo]
+                -> (Exp NodeInfo,[Exp NodeInfo])
+        flatten (App _ f' a') b =
+          flatten f' (a' : b)
+        flatten f' as = (f',as)
+infixApp :: Exp NodeInfo
+         -> Exp NodeInfo
+         -> QOp NodeInfo
+         -> Exp NodeInfo
+         -> Maybe Int64
+         -> Printer ()
+```
+
 # Complex inputs
 
 Quasi-quotes with nested lets and operators
@@ -87,4 +142,48 @@
                           _ ->
                             ListPresentation typeString
                                              (map (snd $(presentVar)) xs)))|]))]
+```
+
+Lots of comments and operators
+
+``` haskell
+bob -- after bob
+ =
+    foo -- next to foo
+    -- line after foo
+        (bar
+             foo -- next to bar foo
+             bar -- next to bar
+         ) -- next to the end paren of (bar)
+        -- line after (bar)
+        mu -- next to mu
+        -- line after mu
+        -- another line after mu
+        zot -- next to zot
+        -- line after zot
+        (case casey -- after casey
+               of
+             Just -- after Just
+              -> do
+                 justice -- after justice
+                  *
+                     foo
+                         (blah * blah + z + 2 / 4 + a - -- before a line break
+                          2 * -- inside this mess
+                          z /
+                          2 /
+                          2 /
+                          aooooo /
+                          aaaaa -- bob comment
+                          ) +
+                     (sdfsdfsd fsdfsdf) -- blah comment
+                 putStrLn "")
+        [1, 2, 3]
+        [ 1 -- foo
+        , ( 2 -- bar
+          , 2.5 -- mu
+           )
+        , 3]
+
+foo = 1 -- after foo
 ```
diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,8 @@
+5.1.0:
+   * Rewrote comment association, more reliable
+   * Added --tab-size flag for indentation spaces
+   * Fixed some miscellaneous bugs
+
 5.0.1:
     * Re-implement using bytestring instead of text
     * Made compatible with GHC 7.8 through to GHC 8.0
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,18 +1,38 @@
 # hindent [![Hackage](https://img.shields.io/hackage/v/hindent.svg?style=flat)](https://hackage.haskell.org/package/hindent) [![Build Status](https://travis-ci.org/chrisdone/hindent.png)](https://travis-ci.org/chrisdone/hindent)
 
-Extensible Haskell pretty printer. Both a library and an
-executable.
+Haskell pretty printer
 
+[Demonstration site](http://chrisdone.com/hindent/)
+
+[Examples](https://github.com/chrisdone/hindent/blob/master/TESTS.md)
+
 ## Install
 
-    $ stack install
+    $ stack install hindent
 
 ## Usage
 
-    hindent is used in a pipeline style:
+    bash-3.2$ hindent --help
+    hindent --version --help --style STYLE --line-length <...> --tab-size <...> [-X<...>]* [<FILENAME>]
+    Version 5.0.1
+    The --style option is now ignored, but preserved for backwards-compatibility.
+    Johan Tibell is the default and only style.
 
-    $ cat path/to/sourcefile.hs | hindent > outfile.hs
+hindent is used in a pipeline style
 
+    $ cat path/to/sourcefile.hs | hindent
+
+Configure tab size with `--tab-size`:
+
+    $ echo 'example = case x of Just p -> foo bar' | hindent --tab-size 2; echo
+    example =
+      case x of
+        Just p -> foo bar
+    $ echo 'example = case x of Just p -> foo bar' | hindent --tab-size 4; echo
+    example =
+        case x of
+            Just p -> foo bar
+
 ## Emacs
 
 In
@@ -34,19 +54,25 @@
 
 ## Vim
 
-The `'formatprg'` option lets you use an external program (like hindent) to
-format your text. Put the following line into ~/.vim/ftplugin/haskell.vim
-to set this option for Haskell files:
+The `'formatprg'` option lets you use an external program (like
+hindent) to format your text. Put the following line into
+~/.vim/ftplugin/haskell.vim to set this option for Haskell files:
 
     setlocal formatprg=hindent
 
 Then you can format with hindent using `gq`. Read `:help gq` and `help
 'formatprg'` for more details.
 
-Note that unlike in emacs you have to take care of selecting a sensible buffer region as input to
-hindent yourself. If that is too much trouble you can try [vim-textobj-haskell](https://github.com/gilligan/vim-textobj-haskell) which provides a text object for top level bindings.
+Note that unlike in emacs you have to take care of selecting a
+sensible buffer region as input to hindent yourself. If that is too
+much trouble you can try
+[vim-textobj-haskell](https://github.com/gilligan/vim-textobj-haskell)
+which provides a text object for top level bindings.
 
 ## Atom
 
-Basic support is provided through [atom/hindent.coffee](https://github.com/chrisdone/hindent/blob/master/atom/hindent.coffee). Mode should be installed as package into `.atom\packages\${PACKAGE_NAME}`,
-here is simple example of atom [package](https://github.com/Heather/atom-hindent).
+Basic support is provided through
+[atom/hindent.coffee](https://github.com/chrisdone/hindent/blob/master/atom/hindent.coffee). Mode
+should be installed as package into `.atom\packages\${PACKAGE_NAME}`,
+here is simple example of atom
+[package](https://github.com/Heather/atom-hindent).
diff --git a/TESTS.md b/TESTS.md
--- a/TESTS.md
+++ b/TESTS.md
@@ -13,16 +13,18 @@
 
 ``` haskell
 module X where
+
+x = 1
 ```
 
 Exports
 
 ``` haskell
 module X
-  (x
-  ,y
-  ,Z
-  ,P(x, z))
+  ( x
+  , y
+  , Z
+  , P(x, z))
   where
 ```
 
@@ -52,22 +54,24 @@
 Lazy patterns in a lambda
 
 ``` haskell
-f = \ ~a -> undefined -- \~a yields parse error on input ‘\~’
+f = \ ~a -> undefined
+ -- \~a yields parse error on input ‘\~’
 ```
 
 Bang patterns in a lambda
 
 ``` haskell
-f = \ !a -> undefined -- \!a yields parse error on input ‘\!’
+f = \ !a -> undefined
+ -- \!a yields parse error on input ‘\!’
 ```
 
 List comprehensions
 
 ``` haskell
 defaultExtensions =
-  [ e
-  | e@EnableExtension {} <- knownExtensions ] \\
-  map EnableExtension badExtensions
+    [ e
+    | e@EnableExtension {} <- knownExtensions ] \\
+    map EnableExtension badExtensions
 ```
 
 Record indentation
@@ -75,10 +79,10 @@
 ``` haskell
 getGitProvider :: EventProvider GitRecord ()
 getGitProvider =
-  EventProvider
-  { getModuleName = "Git"
-  , getEvents = getRepoCommits
-  }
+    EventProvider
+    { getModuleName = "Git"
+    , getEvents = getRepoCommits
+    }
 ```
 
 Records again
@@ -86,11 +90,11 @@
 ``` haskell
 commitToEvent :: FolderPath -> TimeZone -> Commit -> Event.Event
 commitToEvent gitFolderPath timezone commit =
-  Event.Event
-  { pluginName = getModuleName getGitProvider
-  , eventIcon = "glyphicon-cog"
-  , eventDate = localTimeToUTC timezone (commitDate commit)
-  }
+    Event.Event
+    { pluginName = getModuleName getGitProvider
+    , eventIcon = "glyphicon-cog"
+    , eventDate = localTimeToUTC timezone (commitDate commit)
+    }
 ```
 
 Cases
@@ -98,19 +102,18 @@
 ``` haskell
 strToMonth :: String -> Int
 strToMonth month =
-  case month of
-    "Jan" -> 1
-    "Feb" -> 2
-    _ -> error $ "Unknown month " ++ month
+    case month of
+        "Jan" -> 1
+        "Feb" -> 2
+        _ -> error $ "Unknown month " ++ month
 ```
 
 Operators
 
 ``` haskell
 x =
-  Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*>
-  Just thisissolong <*>
-  Just stilllonger
+    Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*> Just thisissolong <*>
+    Just stilllonger
 ```
 
 # Type signatures
@@ -119,8 +122,8 @@
 
 ``` haskell
 fun
-  :: (Class a, Class b)
-  => a -> b -> c
+    :: (Class a, Class b)
+    => a -> b -> c
 ```
 
 Tuples
@@ -134,10 +137,9 @@
 Where clause
 
 ``` haskell
-sayHello :: IO ()
 sayHello = do
-  name <- getLine
-  putStrLn $ greeting name
+    name <- getLine
+    putStrLn $ greeting name
   where
     greeting name = "Hello, " ++ name ++ "!"
 ```
@@ -145,28 +147,39 @@
 Guards and pattern guards
 
 ``` haskell
-f :: Int
 f x
-  | x <- Just x
-  , x <- Just x =
-    case x of
-      Just x -> e
-  | otherwise = do e
+    | x <- Just x
+    , x <- Just x =
+        case x of
+            Just x -> e
+    | otherwise = do e
   where
     x = y
 ```
 
+Multi-way if
+
+``` haskell
+x =
+    if | x <- Just x,
+         x <- Just x ->
+           case x of
+               Just x -> e
+               Nothing -> p
+       | otherwise -> e
+```
+
 Case inside a `where` and `do`
 
 ``` haskell
 g x =
-  case x of
-    a -> x
+    case x of
+        a -> x
   where
     foo =
-      case x of
-        _ -> do
-          launchMissiles
+        case x of
+            _ -> do
+                launchMissiles
       where
         y = 2
 ```
@@ -175,24 +188,251 @@
 
 ``` haskell
 g x =
-  let x = 1
-  in x
+    let x = 1
+    in x
   where
     foo =
-      let y = 2
-          z = 3
-      in y
+        let y = 2
+            z = 3
+        in y
 ```
 
+Lists
+
+``` haskell
+exceptions = [InvalidStatusCode, MissingContentHeader, InternalServerError]
+
+exceptions =
+    [ InvalidStatusCode
+    , MissingContentHeader
+    , InternalServerError
+    , InvalidStatusCode
+    , MissingContentHeader
+    , InternalServerError]
+```
+
+# Johan Tibell compatibility checks
+
+Basic example from Tibbe's style
+
+``` haskell
+sayHello :: IO ()
+sayHello = do
+    name <- getLine
+    putStrLn $ greeting name
+  where
+    greeting name = "Hello, " ++ name ++ "!"
+
+filter :: (a -> Bool) -> [a] -> [a]
+filter _ [] = []
+filter p (x:xs)
+    | p x = x : filter p xs
+    | otherwise = filter p xs
+```
+
+Data declarations
+
+``` haskell
+data Tree a
+    = Branch !a
+             !(Tree a)
+             !(Tree a)
+    | Leaf
+
+data HttpException
+    = InvalidStatusCode Int
+    | MissingContentHeader
+
+data Person = Person
+    { firstName :: !String -- ^ First name
+    , lastName :: !String -- ^ Last name
+    , age :: !Int -- ^ Age
+    }
+```
+
+Spaces between deriving classes
+
+``` haskell
+-- From https://github.com/chrisdone/hindent/issues/167
+data Person = Person
+    { firstName :: !String -- ^ First name
+    , lastName :: !String -- ^ Last name
+    , age :: !Int -- ^ Age
+    } deriving (Eq, Show)
+```
+
+Hanging lambdas
+
+``` haskell
+bar :: IO ()
+bar =
+    forM_ [1, 2, 3] $
+    \n -> do
+        putStrLn "Here comes a number!"
+        print n
+
+foo :: IO ()
+foo =
+    alloca 10 $
+    \a ->
+         alloca 20 $
+         \b -> cFunction fooo barrr muuu (fooo barrr muuu) (fooo barrr muuu)
+```
+
+# Comments
+
+Comments within a declaration
+
+``` haskell
+bob -- after bob
+ =
+    foo -- next to foo
+    -- line after foo
+        (bar
+             foo -- next to bar foo
+             bar -- next to bar
+         ) -- next to the end paren of (bar)
+        -- line after (bar)
+        mu -- next to mu
+        -- line after mu
+        -- another line after mu
+        zot -- next to zot
+        -- line after zot
+        (case casey -- after casey
+               of
+             Just -- after Just
+              -> do
+                 justice -- after justice
+                  *
+                     foo
+                         (blah * blah + z + 2 / 4 + a - -- before a line break
+                          2 * -- inside this mess
+                          z /
+                          2 /
+                          2 /
+                          aooooo /
+                          aaaaa -- bob comment
+                          ) +
+                     (sdfsdfsd fsdfsdf) -- blah comment
+                 putStrLn "")
+        [1, 2, 3]
+        [ 1 -- foo
+        , ( 2 -- bar
+          , 2.5 -- mu
+           )
+        , 3]
+
+foo = 1 -- after foo
+```
+
+Haddock comments
+
+``` haskell
+-- | Module comment.
+module X where
+
+-- | Main doc.
+main :: IO ()
+main = return ()
+
+data X
+    = X -- ^ X is for xylophone.
+    | Y -- ^ Y is for why did I eat that pizza.
+
+data X = X
+    { field1 :: Int -- ^ Field1 is the first field.
+    , field11 :: Char
+      -- ^ This field comment is on its own line.
+    , field2 :: Int -- ^ Field2 is the second field.
+    , field3 :: Char -- ^ This is a long comment which starts next to
+      -- the field but continues onto the next line, it aligns exactly
+      -- with the field name.
+    , field4 :: Char
+      -- ^ This is a long comment which starts on the following line
+      -- from from the field, lines continue at the sme column.
+    }
+```
+
+Comments around regular declarations
+
+``` haskell
+-- This is some random comment.
+-- | Main entry point.
+main = putStrLn "Hello, World!"
+ -- This is another random comment.
+```
+
 # Behaviour checks
 
 Unicode
 
 ``` haskell
-α = γ * "ω" -- υ
+α = γ * "ω"
+ -- υ
 ```
 
 Empty module
 
 ``` haskell
+```
+
+# Complex input
+
+A complex, slow-to-print decl
+
+``` haskell
+quasiQuotes =
+    [ ( ''[]
+      , \(typeVariable:_) _automaticPrinter ->
+             (let presentVar = varE (presentVarName typeVariable)
+              in lamE
+                     [varP (presentVarName typeVariable)]
+                     [|(let typeString = "[" ++ fst $(presentVar) ++ "]"
+                        in ( typeString
+                           , \xs ->
+                                  case fst $(presentVar) of
+                                      "GHC.Types.Char" ->
+                                          ChoicePresentation
+                                              "String"
+                                              [ ( "String"
+                                                , StringPresentation
+                                                      "String"
+                                                      (concatMap
+                                                           getCh
+                                                           (map
+                                                                (snd
+                                                                     $(presentVar))
+                                                                xs)))
+                                              , ( "List of characters"
+                                                , ListPresentation
+                                                      typeString
+                                                      (map (snd $(presentVar)) xs))]
+                                          where getCh (CharPresentation "GHC.Types.Char" ch) =
+                                                    ch
+                                                getCh (ChoicePresentation _ ((_, CharPresentation _ ch):_)) =
+                                                    ch
+                                                getCh _ = ""
+                                      _ ->
+                                          ListPresentation
+                                              typeString
+                                              (map (snd $(presentVar)) xs)))|]))]
+```
+
+Random snippet from hindent itself
+
+``` haskell
+exp' (App _ op a) = do
+    (fits, st) <- fitsOnOneLine (spaced (map pretty (f : args)))
+    if fits
+        then put st
+        else do
+            pretty f
+            newline
+            spaces <- getIndentSpaces
+            indented spaces (lined (map pretty args))
+  where
+    (f, args) = flatten op [a]
+    flatten :: Exp NodeInfo -> [Exp NodeInfo] -> (Exp NodeInfo, [Exp NodeInfo])
+    flatten (App _ f' a') b = flatten f' (a' : b)
+    flatten f' as = (f', as)
 ```
diff --git a/hindent.cabal b/hindent.cabal
--- a/hindent.cabal
+++ b/hindent.cabal
@@ -1,5 +1,5 @@
 name:                hindent
-version:             5.0.1
+version:             5.1.0
 synopsis:            Extensible Haskell pretty printer
 description:         Extensible Haskell pretty printer. Both a library and an executable.
                      .
@@ -32,7 +32,6 @@
   exposed-modules:   HIndent
                      HIndent.Types
                      HIndent.Pretty
-                     HIndent.Comments
   build-depends:     base >= 4.7 && <5
                    , containers
                    , haskell-src-exts >= 1.18
@@ -75,6 +74,7 @@
                    , deepseq
                    , exceptions
                    , utf8-string
+                   , Diff
 
 benchmark hindent-bench
   type: exitcode-stdio-1.0
diff --git a/src/HIndent.hs b/src/HIndent.hs
--- a/src/HIndent.hs
+++ b/src/HIndent.hs
@@ -13,6 +13,7 @@
   ,test
   ,testFile
   ,testAst
+  ,testFileAst
   ,defaultExtensions
   ,getExtensions
   )
@@ -30,17 +31,19 @@
 import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.ByteString.UTF8 as UTF8
 import qualified Data.ByteString.Unsafe as S
-import           Data.Function (on)
+import           Data.Either
+import           Data.Function
 import           Data.Functor.Identity
 import           Data.List
 import           Data.Maybe
 import           Data.Monoid
 import           Data.Text (Text)
 import qualified Data.Text as T
-import           HIndent.Comments
+import           Data.Traversable hiding (mapM)
 import           HIndent.Pretty
 import           HIndent.Types
 import           Language.Haskell.Exts hiding (Style, prettyPrint, Pretty, style, parse)
+import           Prelude
 
 data CodeBlock = HaskellSource ByteString
                | CPPDirectives ByteString
@@ -62,7 +65,7 @@
           fmap (S.lazyByteString .
           addPrefix prefix .
           S.toLazyByteString)
-          (prettyPrint config mode' m comments)
+          (prettyPrint config m comments)
         ParseFailed _ e -> Left e
 
     unlines' = S.concat . intersperse "\n"
@@ -160,44 +163,38 @@
 
 -- | Print the module.
 prettyPrint :: Config
-            -> ParseMode
             -> Module SrcSpanInfo
             -> [Comment]
             -> Either a Builder
-prettyPrint config mode' m comments =
-  let (cs,ast) =
-        annotateComments (fromMaybe m $ applyFixities baseFixities m) comments
-      csComments = map comInfoComment cs
-  in Right (runPrinterStyle
-               config
-               mode'
-
-               -- For the time being, assume that all "free-floating" comments come at the beginning.
-               -- If they were not at the beginning, they would be after some ast node.
-               -- Thus, print them before going for the ast.
-               (do mapM_ (printComment Nothing) csComments
-                   pretty ast))
+prettyPrint config m comments =
+  let ast =
+        evalState
+          (collectAllComments
+             (fromMaybe m (applyFixities baseFixities m)))
+          comments
+  in Right (runPrinterStyle config (pretty ast))
 
 -- | Pretty print the given printable thing.
-runPrinterStyle :: Config -> ParseMode -> Printer () -> Builder
-runPrinterStyle config mode' m =
-    maybe
-        (error "Printer failed with mzero call.")
-        psOutput
-        (runIdentity
-             (runMaybeT
-                  (execStateT
-                       (runPrinter m)
-                       (PrintState
-                            0
-                            mempty
-                            False
-                            0
-                            1
-                            config
-                            False
-                            False
-                            mode'))))
+runPrinterStyle :: Config -> Printer () -> Builder
+runPrinterStyle config m =
+  maybe
+    (error "Printer failed with mzero call.")
+    psOutput
+    (runIdentity
+       (runMaybeT
+          (execStateT
+             (runPrinter m)
+             (PrintState
+              { psIndentLevel = 0
+              , psOutput = mempty
+              , psNewline = False
+              , psColumn = 0
+              , psLine = 1
+              , psConfig = config
+              , psInsideCase = False
+              , psHardLimit = False
+              , psEolComment = False
+              }))))
 
 -- | Parse mode, includes all extensions, doesn't assume any fixities.
 parseMode :: ParseMode
@@ -209,10 +206,15 @@
         isDisabledExtention (DisableExtension _) = False
         isDisabledExtention _ = True
 
+
 -- | Test the given file.
 testFile :: FilePath -> IO ()
 testFile fp  = S.readFile fp >>= test
 
+-- | Test the given file.
+testFileAst :: FilePath -> IO ()
+testFileAst fp  = S.readFile fp >>= print . testAst
+
 -- | Test with the given style, prints to stdout.
 test :: ByteString -> IO ()
 test =
@@ -220,10 +222,17 @@
   reformat defaultConfig Nothing
 
 -- | Parse the source and annotate it with comments, yielding the resulting AST.
-testAst :: ByteString -> Either String ([ComInfo], Module NodeInfo)
+testAst :: ByteString -> Either String (Module NodeInfo)
 testAst x =
   case parseModuleWithComments parseMode (UTF8.toString x) of
-    ParseOk (m,comments) -> Right (annotateComments m comments)
+    ParseOk (m,comments) ->
+      Right
+        (let ast =
+               evalState
+                 (collectAllComments
+                    (fromMaybe m (applyFixities baseFixities m)))
+                 comments
+         in ast)
     ParseFailed _ e -> Left e
 
 -- | Default extensions.
@@ -268,6 +277,129 @@
 -- | Parse an extension.
 readExtension :: String -> Maybe Extension
 readExtension x =
-  case classifyExtension x of
+  case classifyExtension x -- Foo
+       of
     UnknownExtension _ -> Nothing
     x' -> Just x'
+
+--------------------------------------------------------------------------------
+-- Comments
+
+-- | Traverse the structure backwards.
+traverseInOrder
+  :: (Monad m, Traversable t, Functor m)
+  => (b -> b -> Ordering) -> (b -> m b) -> t b -> m (t b)
+traverseInOrder cmp f ast = do
+  indexed <-
+    fmap (zip [0 :: Integer ..] . reverse) (execStateT (traverse (modify . (:)) ast) [])
+  let sorted = sortBy (\(_,x) (_,y) -> cmp x y) indexed
+  results <-
+    mapM
+      (\(i,m) -> do
+         v <- f m
+         return (i, v))
+      sorted
+  evalStateT
+    (traverse
+       (const
+          (do i <- gets head
+              modify tail
+              case lookup i results of
+                Nothing -> error "traverseInOrder"
+                Just x -> return x))
+       ast)
+    [0 ..]
+
+-- | Collect all comments in the module by traversing the tree. Read
+-- this from bottom to top.
+collectAllComments :: Module SrcSpanInfo -> State [Comment] (Module NodeInfo)
+collectAllComments =
+    shortCircuit
+        (traverseBackwards
+         -- Finally, collect backwards comments which come after each node.
+             (collectCommentsBy
+                  (<>)
+                  CommentAfterLine
+                  (\nodeSpan commentSpan ->
+                        fst (srcSpanStart commentSpan) >=
+                        fst (srcSpanEnd nodeSpan)))) <=<
+    shortCircuit
+        (traverse
+         -- Collect forwards comments which start at the end line of a node.
+             (collectCommentsBy
+                  (<>)
+                  CommentSameLine
+                  (\nodeSpan commentSpan ->
+                        fst (srcSpanStart commentSpan) ==
+                        fst (srcSpanEnd nodeSpan)))) <=<
+    shortCircuit
+        (traverseBackwards
+         -- Collect backwards comments which are on the same line as a node.
+             (collectCommentsBy
+                  (<>)
+                  CommentSameLine
+                  (\nodeSpan commentSpan ->
+                        fst (srcSpanStart commentSpan) ==
+                        fst (srcSpanStart nodeSpan) &&
+                        fst (srcSpanStart commentSpan) ==
+                        fst (srcSpanEnd nodeSpan)))) <=<
+    shortCircuit
+        (traverse
+         -- First, collect forwards comments for declarations which both
+         -- start on column 1 and occur before the declaration.
+             (collectCommentsBy
+                  (<>)
+                  CommentBeforeLine
+                  (\nodeSpan commentSpan ->
+                        (snd (srcSpanStart nodeSpan) == 1 &&
+                         snd (srcSpanStart commentSpan) == 1) &&
+                        fst (srcSpanStart commentSpan) <
+                        fst (srcSpanStart nodeSpan)))) .
+    fmap nodify
+  where
+    nodify s = NodeInfo s mempty
+    -- Sort the comments by their end position.
+    traverseBackwards =
+        traverseInOrder
+            (\x y ->
+                  on
+                      (flip compare)
+                      (srcSpanEnd . srcInfoSpan . nodeInfoSpan)
+                      x
+                      y)
+    -- Stop traversing if all comments have been consumed.
+    shortCircuit m v = do
+        comments <- get
+        if null comments
+            then return v
+            else m v
+
+-- | Collect comments by satisfying the given predicate, to collect a
+-- comment means to remove it from the pool of available comments in
+-- the State. This allows for a multiple pass approach.
+collectCommentsBy
+  :: ([NodeComment] -> [NodeComment] -> [NodeComment])
+  -> (String -> NodeComment)
+  -> (SrcSpan -> SrcSpan -> Bool)
+  -> NodeInfo
+  -> State [Comment] NodeInfo
+collectCommentsBy append cons predicate nodeInfo@(NodeInfo (SrcSpanInfo nodeSpan _) _) = do
+  comments <- get
+  let (others,mine) =
+        partitionEithers
+          (map
+             (\comment@(Comment _ commentSpan commentString) ->
+                 if predicate nodeSpan (setFilename commentString commentSpan)
+                   then Right (cons commentString)
+                   else Left comment)
+             comments)
+  put others
+  return
+    (nodeInfo
+     { nodeInfoComments = append (nodeInfoComments nodeInfo) mine
+     })
+  where
+    setFilename cs sp =
+      sp
+      { srcSpanFilename = cs
+      }
diff --git a/src/HIndent/Comments.hs b/src/HIndent/Comments.hs
deleted file mode 100644
--- a/src/HIndent/Comments.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-}
-
--- | Comment handling.
-
-module HIndent.Comments where
-
-import           Control.Arrow (first, second)
-import           Control.Monad.State.Strict
-import           Data.Data
-import qualified Data.Foldable
-import qualified Data.Map.Strict as M
-import           Data.Monoid
-import           Data.Traversable
-import           HIndent.Types
-import           Language.Haskell.Exts hiding (Style,prettyPrint,Pretty,style,parse)
-import           Prelude
-
--- Order by start of span, larger spans before smaller spans.
-newtype OrderByStart =
-  OrderByStart SrcSpan
-  deriving (Eq)
-
-instance Ord OrderByStart where
-  compare (OrderByStart l) (OrderByStart r) =
-    compare (srcSpanStartLine l)
-            (srcSpanStartLine r) `mappend`
-    compare (srcSpanStartColumn l)
-            (srcSpanStartColumn r) `mappend`
-    compare (srcSpanEndLine r)
-            (srcSpanEndLine l) `mappend`
-    compare (srcSpanEndColumn r)
-            (srcSpanEndColumn l)
-
--- Order by end of span, smaller spans before larger spans.
-newtype OrderByEnd =
-  OrderByEnd SrcSpan
-  deriving (Eq)
-
-instance Ord OrderByEnd where
-  compare (OrderByEnd l) (OrderByEnd r) =
-    compare (srcSpanEndLine l)
-            (srcSpanEndLine r) `mappend`
-    compare (srcSpanEndColumn l)
-            (srcSpanEndColumn r) `mappend`
-    compare (srcSpanStartLine r)
-            (srcSpanStartLine l) `mappend`
-    compare (srcSpanStartColumn r)
-            (srcSpanStartColumn l)
-
--- | Annotate the AST with comments.
-annotateComments :: forall ast. (Data (ast NodeInfo),Traversable ast,Annotated ast,Show (ast NodeInfo))
-                 => ast SrcSpanInfo -> [Comment] -> ([ComInfo],ast NodeInfo)
-annotateComments src comments =
-  evalState (do _ <- traverse assignComment comments
-                cis <- gets fst
-                ast <- traverse transferComments src
-                return (cis,ast))
-            ([],nodeinfos)
-  where
-    nodeinfos :: M.Map SrcSpanInfo NodeInfo
-    nodeinfos = Data.Foldable.foldr (\ssi -> M.insert ssi (NodeInfo ssi [])) M.empty src
-
-    -- Assign a single comment to the right AST node
-    assignComment :: Comment -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) ()
-    assignComment comment@(Comment _ cspan _) =
-      -- Find the biggest AST node directly in front of this comment.
-      case nodeBefore comment of
-        -- Comments before any AST node are handled separately.
-        Nothing -> modify $ first $ (:) (ComInfo comment Nothing)
-
-        Just ssi ->
-          -- Comments on the same line as the AST node belong to this node.
-          if sameline (srcInfoSpan ssi) cspan
-             then insertComment After ssi
-             else do nodeinfo <- gets ((M.! ssi) . snd)
-                     case nodeinfo of
-                       -- We've already collected comments for this
-                       -- node and this comment is a continuation.
-                       NodeInfo _ ((ComInfo c' _):_)
-                         | aligned c' comment -> insertComment After ssi
-
-                       -- The comment does not belong to this node.
-                       -- If there is a node following this comment,
-                       -- assign it to that node, else keep it here,
-                       -- anyway.
-                       _ ->
-                         case nodeAfter comment of
-                           Nothing -> insertComment After ssi
-                           Just ssi' -> insertComment Before ssi'
-      where
-        sameline :: SrcSpan -> SrcSpan -> Bool
-        sameline before after = srcSpanEndLine before == srcSpanStartLine after
-
-        aligned :: Comment -> Comment -> Bool
-        aligned (Comment _ before _) (Comment _ after _) =
-          srcSpanEndLine before == srcSpanStartLine after - 1 &&
-          srcSpanStartColumn before == srcSpanStartColumn after
-
-        insertComment :: ComInfoLocation -> SrcSpanInfo -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) ()
-        insertComment l ssi = modify $ second $ M.adjust (addComment (ComInfo comment (Just l))) ssi
-
-        addComment :: ComInfo -> NodeInfo -> NodeInfo
-        addComment x (NodeInfo s xs) = NodeInfo s (x : xs)
-
-    -- Transfer collected comments into the AST.
-    transferComments :: SrcSpanInfo -> State ([ComInfo],M.Map SrcSpanInfo NodeInfo) NodeInfo
-    transferComments ssi =
-      do ni <- gets ((M.! ssi) . snd)
-         -- Sometimes, there are multiple AST nodes with the same
-         -- SrcSpan.  Make sure we assign comments to only one of
-         -- them.
-         modify $ second $ M.adjust (\(NodeInfo s _) -> NodeInfo s []) ssi
-         return ni { nodeInfoComments = reverse $ nodeInfoComments ni }
-
-    nodeBefore (Comment _ ss _) = fmap snd $ (OrderByEnd ss) `M.lookupLT` spansByEnd
-    nodeAfter (Comment _ ss _) = fmap snd $ (OrderByStart ss) `M.lookupGT` spansByStart
-
-    spansByStart = Data.Foldable.foldr (\ssi -> M.insert (OrderByStart $ srcInfoSpan ssi) ssi) M.empty src
-    spansByEnd = Data.Foldable.foldr (\ssi -> M.insert (OrderByEnd $ srcInfoSpan ssi) ssi) M.empty src
diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
--- a/src/HIndent/Pretty.hs
+++ b/src/HIndent/Pretty.hs
@@ -9,55 +9,10 @@
 -- | Pretty printing.
 
 module HIndent.Pretty
-  (
-  -- * Printing
-    Pretty
-  , pretty
-  , prettyNoExt
-  -- * Insertion
-  , write
-  , newline
-  , space
-  , comma
-  , int
-  , string
-  -- * Common node types
-  , withCtx
-  , printComment
-  , printComments
-  , withCaseContext
-  , rhsSeparator
-  -- * Interspersing
-  , inter
-  , spaced
-  , lined
-  , prefixedLined
-  , commas
-  -- * Wrapping
-  , parens
-  , brackets
-  , braces
-  -- * Indentation
-  , indented
-  , indentedBlock
-  , column
-  , getColumn
-  , getLineNum
-  , depend
-  , dependBind
-  , swing
-  , swingBy
-  , getIndentSpaces
-  , getColumnLimit
-  -- * Predicates
-  , nullBinds
-  -- * Sandboxing
-  , sandbox
-  -- * Fallback
-  , pretty'
-  )
+  (pretty)
   where
 
+import           Control.Applicative
 import           Control.Monad.State.Strict hiding (state)
 import qualified Data.ByteString.Builder as S
 import qualified Data.Foldable
@@ -69,7 +24,6 @@
 import           Data.Typeable
 import           HIndent.Types
 import qualified Language.Haskell.Exts as P
-import           Language.Haskell.Exts.Comments
 import           Language.Haskell.Exts.SrcLoc
 import           Language.Haskell.Exts.Syntax
 import           Prelude hiding (exp)
@@ -81,71 +35,53 @@
 class (Annotated ast,Typeable ast) => Pretty ast where
   prettyInternal :: ast NodeInfo -> Printer ()
 
--- | Pretty print using extenders.
-pretty :: (Pretty ast)
+-- | Pretty print including comments.
+pretty :: (Pretty ast,Show (ast NodeInfo))
        => ast NodeInfo -> Printer ()
 pretty a = do
-    printComments Before a
-    depend (prettyNoExt a) (printComments After a)
-
--- | Run the basic printer for the given node without calling an
--- extension hook for this node, but do allow extender hooks in child
--- nodes. Also auto-inserts comments.
-prettyNoExt :: (Pretty ast)
-            => ast NodeInfo -> Printer ()
-prettyNoExt = prettyInternal
-
--- | Print comments of a node.
-printComments :: (Pretty ast)
-              => ComInfoLocation -> ast NodeInfo -> Printer ()
-printComments loc' ast = do
-  let correctLocation comment = comInfoLocation comment == Just loc'
-      commentsWithLocation = filter correctLocation (nodeInfoComments info)
-  comments <- return $ map comInfoComment commentsWithLocation
-
-  forM_ comments $ \comment -> do
-    -- Preceeding comments must have a newline before them.
-    hasNewline <- gets psNewline
-    when (not hasNewline && loc' == Before) newline
-
-    printComment (Just $ srcInfoSpan $ nodeInfoSpan info) comment
-  where info = ann ast
-
--- | Pretty print a comment.
-printComment :: MonadState (PrintState) m => Maybe SrcSpan -> Comment -> m ()
-printComment mayNodespan (Comment inline cspan str) =
-  do -- Insert proper amount of space before comment.
-     -- This maintains alignment. This cannot force comments
-     -- to go before the left-most possible indent (specified by depends).
-     case mayNodespan of
-       Just nodespan ->
-         do let neededSpaces = srcSpanStartColumn cspan -
-                               max 1 (srcSpanEndColumn nodespan)
-            replicateM_ neededSpaces space
-       Nothing -> return ()
-
-     if inline
-        then do write "{-"
-                string str
-                write "-}"
-                when (1 == srcSpanStartColumn cspan) $
-                  modify (\s -> s {psEolComment = True})
-        else do write "--"
-                string str
-                modify (\s ->
-                          s {psEolComment = True})
+  mapM_
+    (\c' -> do
+       case c' of
+         CommentBeforeLine c -> do
+           write ("--" ++ c)
+           newline
+         _ -> return ())
+    comments
+  prettyInternal a
+  mapM_
+    (\(i,c') -> do
+       case c' of
+         CommentSameLine c -> do
+           write (" --" ++ c)
+           modify
+             (\s ->
+                 s
+                 { psEolComment = True
+                 })
+         CommentAfterLine c -> do
+           when (i == 0) newline
+           write ("--" ++ c)
+           modify
+             (\s ->
+                 s
+                 { psEolComment = True
+                 })
+         _ -> return ())
+    (zip [0 :: Int ..] comments)
+  where
+    comments = nodeInfoComments (ann a)
 
 -- | Pretty print using HSE's own printer. The 'P.Pretty' class here
 -- is HSE's.
-pretty' :: (Pretty ast,P.Pretty (ast SrcSpanInfo),MonadState (PrintState) m)
-        => ast NodeInfo -> m ()
+pretty' :: (Pretty ast,P.Pretty (ast SrcSpanInfo))
+        => ast NodeInfo -> Printer ()
 pretty' = write . P.prettyPrint . fmap nodeInfoSpan
 
 --------------------------------------------------------------------------------
 -- * Combinators
 
 -- | Increase indentation level by n spaces for the given printer.
-indented :: MonadState (PrintState) m => Int64 -> m a -> m a
+indented :: Int64 -> Printer a -> Printer a
 indented i p =
   do level <- gets psIndentLevel
      modify (\s -> s {psIndentLevel = level + i})
@@ -153,38 +89,40 @@
      modify (\s -> s {psIndentLevel = level})
      return m
 
-indentedBlock :: MonadState (PrintState) m => m a -> m a
+indentedBlock :: Printer a -> Printer a
 indentedBlock p =
   do indentSpaces <- getIndentSpaces
      indented indentSpaces p
 
 -- | Print all the printers separated by spaces.
-spaced :: MonadState (PrintState) m => [m ()] -> m ()
+spaced :: [Printer ()] -> Printer ()
 spaced = inter space
 
 -- | Print all the printers separated by commas.
-commas :: MonadState (PrintState) m => [m ()] -> m ()
-commas = inter comma
+commas :: [Printer ()] -> Printer ()
+commas = inter (do comma; space)
 
 -- | Print all the printers separated by sep.
-inter :: MonadState (PrintState) m => m () -> [m ()] -> m ()
+inter :: Printer () -> [Printer ()] -> Printer ()
 inter sep ps =
-  foldr (\(i,p) next ->
-           depend (do p
-                      if i < length ps
-                         then sep
-                         else return ())
-                  next)
-        (return ())
-        (zip [1 ..] ps)
+  foldr
+    (\(i,p) next ->
+        depend
+          (do p
+              if i < length ps
+                then sep
+                else return ())
+          next)
+    (return ())
+    (zip [1 ..] ps)
 
 -- | Print all the printers separated by newlines.
-lined :: MonadState (PrintState) m => [m ()] -> m ()
+lined :: [Printer ()] -> Printer ()
 lined ps = sequence_ (intersperse newline ps)
 
 -- | Print all the printers separated newlines and optionally a line
 -- prefix.
-prefixedLined :: MonadState (PrintState) m => String -> [m ()] -> m ()
+prefixedLined :: String -> [Printer ()] -> Printer ()
 prefixedLined pref ps' =
   case ps' of
     [] -> return ()
@@ -200,7 +138,7 @@
 
 -- | Set the (newline-) indent level to the given column for the given
 -- printer.
-column :: MonadState (PrintState) m => Int64 -> m a -> m a
+column :: Int64 -> Printer a -> Printer a
 column i p =
   do level <- gets psIndentLevel
      modify (\s -> s {psIndentLevel = i})
@@ -208,23 +146,14 @@
      modify (\s -> s {psIndentLevel = level})
      return m
 
--- | Get the current indent level.
-getColumn :: MonadState (PrintState) m => m Int64
-getColumn = gets psColumn
-
--- | Get the current line number.
-getLineNum :: MonadState (PrintState) m => m Int64
-getLineNum = gets psLine
-
 -- | Output a newline.
-newline :: MonadState (PrintState) m => m ()
+newline :: Printer ()
 newline =
   do write "\n"
      modify (\s -> s {psNewline = True})
 
 -- | Set the context to a case context, where RHS is printed with -> .
-withCaseContext :: MonadState (PrintState) m
-                => Bool -> m a -> m a
+withCaseContext :: Bool -> Printer a -> Printer a
 withCaseContext bool pr =
   do original <- gets psInsideCase
      modify (\s -> s {psInsideCase = bool})
@@ -233,8 +162,7 @@
      return result
 
 -- | Get the current RHS separator, either = or -> .
-rhsSeparator :: MonadState (PrintState) m
-             => m ()
+rhsSeparator :: Printer ()
 rhsSeparator =
   do inCase <- gets psInsideCase
      if inCase
@@ -243,7 +171,7 @@
 
 -- | Make the latter's indentation depend upon the end column of the
 -- former.
-depend :: MonadState (PrintState) m => m () -> m b -> m b
+depend :: Printer () -> Printer b -> Printer b
 depend maker dependent =
   do state' <- get
      maker
@@ -253,20 +181,8 @@
         then column col dependent
         else dependent
 
--- | Make the latter's indentation depend upon the end column of the
--- former.
-dependBind :: MonadState (PrintState) m => m a -> (a -> m b) -> m b
-dependBind maker dependent =
-  do state' <- get
-     v <- maker
-     st <- get
-     col <- gets psColumn
-     if psLine state' /= psLine st || psColumn state' /= psColumn st
-        then column col (dependent v)
-        else (dependent v)
-
 -- | Wrap in parens.
-parens :: MonadState (PrintState) m => m a -> m a
+parens :: Printer a -> Printer a
 parens p =
   depend (write "(")
          (do v <- p
@@ -274,7 +190,7 @@
              return v)
 
 -- | Wrap in braces.
-braces :: MonadState (PrintState) m => m a -> m a
+braces :: Printer a -> Printer a
 braces p =
   depend (write "{")
          (do v <- p
@@ -282,7 +198,7 @@
              return v)
 
 -- | Wrap in brackets.
-brackets :: MonadState (PrintState) m => m a -> m a
+brackets :: Printer a -> Printer a
 brackets p =
   depend (write "[")
          (do v <- p
@@ -290,31 +206,34 @@
              return v)
 
 -- | Write a space.
-space :: MonadState (PrintState) m => m ()
+space :: Printer ()
 space = write " "
 
 -- | Write a comma.
-comma :: MonadState (PrintState) m => m ()
+comma :: Printer ()
 comma = write ","
 
 -- | Write an integral.
-int :: (MonadState (PrintState) m)
-    => Integer -> m ()
+int :: Integer -> Printer ()
 int = write . show
 
 -- | Write out a string, updating the current position information.
-write :: MonadState (PrintState) m => String -> m ()
+write :: String -> Printer ()
 write x =
   do eol <- gets psEolComment
-     when (eol && x /= "\n") newline
+     hardFail <- gets psHardLimit
+     let addingNewline = eol && x /= "\n"
+     when addingNewline newline
      state <- get
-     let clearEmpty =
-           configClearEmptyLines (psConfig state)
-         writingNewline = x == "\n"
+     when
+       hardFail
+       (guard
+          (additionalLines == 0 &&
+           (psColumn state < configMaxColumns (psConfig state))))
+     let writingNewline = x == "\n"
          out :: String
          out =
-           if psNewline state &&
-              not (clearEmpty && writingNewline)
+           if psNewline state && not writingNewline
               then (replicate (fromIntegral (psIndentLevel state))
                                ' ') <>
                    x
@@ -322,8 +241,8 @@
      modify (\s ->
                s {psOutput = psOutput state <> S.stringUtf8 out
                  ,psNewline = False
-                 ,psEolComment = False
                  ,psLine = psLine state + fromIntegral additionalLines
+                 ,psEolComment= False
                  ,psColumn =
                     if additionalLines > 0
                        then fromIntegral (length (concat (take 1 (reverse srclines))))
@@ -333,23 +252,17 @@
           length (filter (== '\n') x)
 
 -- | Write a string.
-string :: MonadState (PrintState) m => String -> m ()
+string :: String -> Printer ()
 string = write
 
 -- | Indent spaces, e.g. 2.
-getIndentSpaces :: MonadState (PrintState) m => m Int64
+getIndentSpaces :: Printer Int64
 getIndentSpaces =
   gets (configIndentSpaces . psConfig)
 
--- | Column limit, e.g. 80
-getColumnLimit :: MonadState (PrintState) m => m Int64
-getColumnLimit =
-  gets (configMaxColumns . psConfig)
-
 -- | Play with a printer and then restore the state to what it was
 -- before.
-sandbox :: MonadState s m
-        => m a -> m (a,s)
+sandbox :: Printer a -> Printer (a,PrintState)
 sandbox p =
   do orig <- get
      a <- p
@@ -357,13 +270,8 @@
      put orig
      return (a,new)
 
--- | No binds?
-nullBinds :: Binds NodeInfo -> Bool
-nullBinds (BDecls _ x) = null x
-nullBinds (IPBinds _ x) = null x
-
 -- | Render a type with a context, or not.
-withCtx :: (Pretty ast)
+withCtx :: (Pretty ast,Show (ast NodeInfo))
         => Maybe (ast NodeInfo) -> Printer b -> Printer b
 withCtx Nothing m = m
 withCtx (Just ctx) m =
@@ -385,14 +293,14 @@
 swing a b =
   do orig <- gets psIndentLevel
      a
-     (fits,st) <- fitsOnOneLine (do space
-                                    b)
-     if fits
-        then put st
-        else do newline
-                indentSpaces <- getIndentSpaces
-                _ <- column (orig + indentSpaces) b
-                return ()
+     mst <- fitsOnOneLine (do space
+                              b)
+     case mst of
+       Just st -> put st
+       Nothing -> do newline
+                     indentSpaces <- getIndentSpaces
+                     _ <- column (orig + indentSpaces) b
+                     return ()
 
 -- | Swing the second printer below and indented with respect to the first by
 -- the specified amount.
@@ -510,29 +418,28 @@
 -- | Do after lambda should swing.
 exp (Lambda _ pats (Do l stmts)) =
   do
-     (fits,st) <-
-       fitsOnOneLine
-         (do write "\\"
-             spaced (map pretty pats)
-             write " -> "
-             pretty (Do l stmts))
-     if fits
-        then put st
-        else swing (do write "\\"
-                       spaced (map pretty pats)
-                       write " -> do")
-                    (lined (map pretty stmts))
+     mst <-
+          fitsOnOneLine
+            (do write "\\"
+                spaced (map pretty pats)
+                write " -> "
+                pretty (Do l stmts))
+     case mst of
+       Nothing -> swing (do write "\\"
+                            spaced (map pretty pats)
+                            write " -> do")
+                         (lined (map pretty stmts))
+       Just st -> put st
 -- | Space out tuples.
 exp (Tuple _ boxed exps) =
   depend (write (case boxed of
                    Unboxed -> "(#"
                    Boxed -> "("))
-         (do single <- isSingleLiner p
-             underflow <- fmap not (isOverflow p)
-             if single && underflow
-                then p
-                else prefixedLined ","
-                                   (map (depend space . pretty) exps)
+         (do mst <- fitsOnOneLine p
+             case mst of
+               Nothing -> prefixedLined ","
+                                        (map (depend space . pretty) exps)
+               Just st -> put st
              write (case boxed of
                       Unboxed -> "#)"
                       Boxed -> ")"))
@@ -571,32 +478,33 @@
             _ ->
               depend (write str)
                      (pretty e)
--- | App algorithm similar to ChrisDone algorithm, but with no
--- parent-child alignment.
-exp (App _ op a) =
-  do (fits,st) <-
-       fitsOnOneLine (spaced (map pretty (f : args)))
-     if fits
-        then put st
-        else do pretty f
-                newline
-                spaces <- getIndentSpaces
-                indented spaces (lined (map pretty args))
-  where (f,args) = flatten op [a]
-        flatten :: Exp NodeInfo
-                -> [Exp NodeInfo]
-                -> (Exp NodeInfo,[Exp NodeInfo])
-        flatten (App _ f' a') b =
-          flatten f' (a' : b)
-        flatten f' as = (f',as)
+-- | Render on one line, or otherwise render the op with the arguments
+-- listed line by line.
+exp (App _ op arg) = do
+  let flattened = flatten op ++ [arg]
+  mst <- fitsOnOneLine (spaced (map pretty flattened))
+  case mst of
+    Nothing -> do
+      let (f:args) = flattened
+      pretty f
+      newline
+      spaces <- getIndentSpaces
+      indented spaces (lined (map pretty args))
+    Just st -> put st
+  where
+    flatten (App label' op' arg') = flatten op' ++ [amap (addComments label') arg']
+    flatten x = [x]
+    addComments n1 n2 =
+      n2
+      { nodeInfoComments = nub (nodeInfoComments n2 ++ nodeInfoComments n1)
+      }
 -- | Space out commas in list.
 exp (List _ es) =
-  do single <- isSingleLiner p
-     underflow <- fmap not (isOverflow p)
-     if single && underflow
-        then p
-        else brackets (prefixedLined ","
-                                     (map (depend space . pretty) es))
+  do mst <- fitsOnOneLine p
+     case mst of
+       Nothing -> brackets (prefixedLined ","
+                                          (map (depend space . pretty) es))
+       Just st -> put st
   where p =
           brackets (inter (write ", ")
                           (map pretty es))
@@ -701,20 +609,41 @@
 exp (MultiIf _ alts) =
   withCaseContext
     True
-    (depend (write "if ")
-            (lined (map (\p ->
-                           do write "| "
-                              pretty p)
-                        alts)))
+    (depend
+       (write "if ")
+       (lined
+          (map
+             (\p -> do
+                write "| "
+                prettyG p)
+             alts)))
+  where
+    prettyG (GuardedRhs _ stmts e) = do
+      indented
+        1
+        (do (lined (map
+                         (\(i,p) -> do
+                            unless (i == 1)
+                                   space
+                            pretty p
+                            unless (i == length stmts)
+                                   (write ","))
+                         (zip [1..] stmts))))
+      swing (write " " >> rhsSeparator) (pretty e)
 exp (Lit _ lit) = prettyInternal lit
+exp (Var _ q) = case q of
+                  Special _ Cons{} -> parens (pretty q)
+                  _ -> pretty q
+exp (IPVar _ q) = pretty q
+exp (Con _ q) = case q of
+                  Special _ Cons{} -> parens (pretty q)
+                  _ -> pretty q
+
 exp x@XTag{} = pretty' x
 exp x@XETag{} = pretty' x
 exp x@XPcdata{} = pretty' x
 exp x@XExpTag{} = pretty' x
 exp x@XChildTag{} = pretty' x
-exp x@Var{} = pretty' x
-exp x@IPVar{} = pretty' x
-exp x@Con{} = pretty' x
 exp x@CorePragma{} = pretty' x
 exp x@SCCPragma{} = pretty' x
 exp x@GenPragma{} = pretty' x
@@ -731,6 +660,9 @@
   error "FIXME: No implementation for ParComp."
 exp (OverloadedLabel _ label) = string ('#' : label)
 
+instance Pretty IPName where
+ prettyInternal = pretty'
+
 instance Pretty Stmt where
   prettyInternal =
     stmt
@@ -843,7 +775,7 @@
 
 instance Pretty Deriving where
   prettyInternal (Deriving _ heads) =
-    do write "deriving"
+    do write " deriving"
        space
        let heads' =
              if length heads == 1
@@ -955,17 +887,6 @@
 instance Pretty GuardedRhs where
   prettyInternal  =
     guardedRhs
-    {-case x of
-      GuardedRhs _ stmts e ->
-        do indented 1
-                    (do prefixedLined
-                          ","
-                          (map (\p ->
-                                  do space
-                                     pretty p)
-                               stmts))
-           swing (write " " >> rhsSeparator >> write " ")
-                 (pretty e)-}
 
 instance Pretty InjectivityInfo where
   prettyInternal x = pretty' x
@@ -1088,23 +1009,6 @@
                (do space
                    pretty var)
 
-instance Pretty SpecialCon where
-  prettyInternal s =
-    case s of
-      UnitCon _ -> write "()"
-      ListCon _ -> write "[]"
-      FunCon _ -> write "->"
-      TupleCon _ Boxed i ->
-        string ("(" ++
-                replicate (i - 1) ',' ++
-                ")")
-      TupleCon _ Unboxed i ->
-        string ("(#" ++
-                replicate (i - 1) ',' ++
-                "#)")
-      Cons _ -> write ":"
-      UnboxedSingleCon _ -> write "(##)"
-
 instance Pretty Overlap where
   prettyInternal (Overlap _) = write "{-# OVERLAP #-}"
   prettyInternal (NoOverlap _) = write "{-# NO_OVERLAP #-}"
@@ -1121,23 +1025,24 @@
   prettyInternal x =
     case x of
       Module _ mayModHead pragmas imps decls ->
-        inter (do newline
-                  newline)
-              (mapMaybe (\(isNull,r) ->
-                           if isNull
-                              then Nothing
-                              else Just r)
-                        [(null pragmas,inter newline (map pretty pragmas))
-                        ,(case mayModHead of
-                            Nothing -> (True,return ())
-                            Just modHead -> (False,pretty modHead))
-                        ,(null imps,inter newline (map pretty imps))
-                        ,(null decls
-                         ,interOf newline
-                                  (map (\case
-                                          r@TypeSig{} -> (1,pretty r)
-                                          r -> (2,pretty r))
-                                       decls))])
+        do inter (do newline
+                     newline)
+                 (mapMaybe (\(isNull,r) ->
+                              if isNull
+                                 then Nothing
+                                 else Just r)
+                           [(null pragmas,inter newline (map pretty pragmas))
+                           ,(case mayModHead of
+                               Nothing -> (True,return ())
+                               Just modHead -> (False,pretty modHead))
+                           ,(null imps,inter newline (map pretty imps))
+                           ,(null decls
+                            ,interOf newline
+                                     (map (\case
+                                             r@TypeSig{} -> (1,pretty r)
+                                             r -> (2,pretty r))
+                                          decls))])
+           newline
         where interOf i ((c,p):ps) =
                 case ps of
                   [] -> p
@@ -1210,11 +1115,35 @@
   prettyInternal x = pretty' x
 
 instance Pretty Name where
-  prettyInternal = pretty'
+  prettyInternal = pretty' -- Var
 
 instance Pretty QName where
-  prettyInternal = pretty'
+  prettyInternal =
+    \case
+      Qual _ m n -> do
+        pretty m
+        write "."
+        pretty n
+      UnQual _ n -> pretty n
+      Special _ c -> pretty c
 
+instance Pretty SpecialCon where
+  prettyInternal s =
+    case s of
+      UnitCon _ -> write "()"
+      ListCon _ -> write "[]"
+      FunCon _ -> write "->"
+      TupleCon _ Boxed i ->
+        string ("(" ++
+                replicate (i - 1) ',' ++
+                ")")
+      TupleCon _ Unboxed i ->
+        string ("(#" ++
+                replicate (i - 1) ',' ++
+                "#)")
+      Cons _ -> write ":"
+      UnboxedSingleCon _ -> write "(##)"
+
 instance Pretty QOp where
   prettyInternal = pretty'
 
@@ -1263,7 +1192,7 @@
                           (map pretty es))
 
 instance Pretty ExportSpec where
-  prettyInternal = pretty'
+  prettyInternal x = string " " >> pretty' x
 
 -- Do statements need to handle infix expression indentation specially because
 -- do x *
@@ -1301,12 +1230,12 @@
                 -> (Exp NodeInfo -> Printer ())
                 -> Printer ()
 dependOrNewline left right f =
-  do (fits,st) <- fitsOnOneLine renderDependent
-     if fits
-        then put st
-        else do left
-                newline
-                (f right)
+  do msg <- fitsOnOneLine renderDependent
+     case msg of
+       Nothing -> do left
+                     newline
+                     (f right)
+       Just st -> put st
   where renderDependent = depend left (f right)
 
 -- | Handle do and case specially and also space out guards more.
@@ -1320,20 +1249,20 @@
      swingBy indentation
              (write "do")
              (lined (map pretty dos))
-rhs (UnGuardedRhs _ e) =
-  do (fits,st) <-
-       fitsOnOneLine
-         (do write " "
-             rhsSeparator
-             write " "
-             pretty e)
-     if fits
-        then put st
-        else swing (write " " >> rhsSeparator)
-                    (pretty e)
+rhs (UnGuardedRhs _ e) = do
+  msg <-
+    fitsOnOneLine
+      (do write " "
+          rhsSeparator
+          write " "
+          pretty e)
+  case msg of
+    Nothing -> swing (write " " >> rhsSeparator) (pretty e)
+    Just st -> put st
 rhs (GuardedRhss _ gas) =
   do newline
-     indented 2
+     n <- getIndentSpaces
+     indented n
               (lined (map (\p ->
                              do write "|"
                                 pretty p)
@@ -1355,32 +1284,35 @@
      write (if inCase then " -> " else " = ")
      swing (write "do")
             (lined (map pretty dos))
-guardedRhs (GuardedRhs _ stmts e) =
-  do (fits,st) <-
-       fitsOnOneLine
-         (indented 1
-                   (do prefixedLined
-                         ","
-                         (map (\p ->
-                                 do space
-                                    pretty p)
-                              stmts)))
-     put st
-     if fits
-        then do (fits',st') <-
-                  fitsOnOneLine
-                    (do write " "
-                        rhsSeparator
-                        write " "
-                        pretty e)
-                if fits'
-                   then put st'
-                   else swingIt
-        else swingIt
-  where swingIt =
-          swing (write " " >> rhsSeparator)
-                 (pretty e)
-
+guardedRhs (GuardedRhs _ stmts e) = do
+    mst <- fitsOnOneLine printStmts
+    case mst of
+      Just st -> do
+        put st
+        mst' <-
+          fitsOnOneLine
+            (do write " "
+                rhsSeparator
+                write " "
+                pretty e)
+        case mst' of
+          Just st' -> put st'
+          Nothing -> swingIt
+      Nothing -> do
+        printStmts
+        swingIt
+  where
+    printStmts =
+      indented
+        1
+        (do prefixedLined
+              ","
+              (map
+                 (\p -> do
+                    space
+                    pretty p)
+                 stmts))
+    swingIt = swing (write " " >> rhsSeparator) (pretty e)
 
 match :: Match NodeInfo -> Printer ()
 match (Match _ name pats rhs' mbinds) =
@@ -1404,13 +1336,13 @@
 -- | Format contexts with spaces and commas between class constraints.
 context :: Context NodeInfo -> Printer ()
 context ctx@(CxTuple _ asserts) =
-  do (fits,st) <-
-       fitsOnOneLine
-         (parens (inter (comma >> space)
-                        (map pretty asserts)))
-     if fits
-        then put st
-        else prettyNoExt ctx
+  do mst <-
+          fitsOnOneLine
+            (parens (inter (comma >> space)
+                           (map pretty asserts)))
+     case mst of
+       Nothing -> prettyInternal ctx
+       Just st -> put st
 context ctx = case ctx of
                 CxSingle _ a -> pretty a
                 CxTuple _ as ->
@@ -1418,7 +1350,7 @@
                                         (map pretty as))
                 CxEmpty _ -> parens (return ())
 
-unboxParens :: MonadState (PrintState) m => m a -> m a
+unboxParens :: Printer a -> Printer a
 unboxParens p =
   depend (write "(# ")
          (do v <- p
@@ -1497,19 +1429,20 @@
 --     -> IO ()
 --
 decl' (TypeSig _ names ty') =
-  do small <- isSmall (declTy ty')
-     if small
-        then depend (do inter (write ", ")
-                              (map pretty names)
-                        write " :: ")
-                    (declTy ty')
-        else do inter (write ", ")
-                      (map pretty names)
-                newline
-                indentSpaces <- getIndentSpaces
-                indented indentSpaces
-                         (depend (write ":: ")
-                                 (declTy ty'))
+  do mst <- fitsOnOneLine (declTy ty')
+     case mst of
+       Just{} -> depend (do inter (write ", ")
+                                  (map pretty names)
+                            write " :: ")
+                          (declTy ty')
+       Nothing -> do inter (write ", ")
+                           (map pretty names)
+                     newline
+                     indentSpaces <- getIndentSpaces
+                     indented indentSpaces
+                              (depend (write ":: ")
+                                      (declTy ty'))
+
   where declTy dty =
           case dty of
             TyForall _ mbinds mctx ty ->
@@ -1532,14 +1465,14 @@
         collapseFaps (TyFun _ arg result) = arg : collapseFaps result
         collapseFaps e = [e]
         prettyTy ty =
-          do small <- isSmall (pretty ty)
-             if small
-                then pretty ty
-                else case collapseFaps ty of
-                       [] -> pretty ty
-                       tys ->
-                         prefixedLined "-> "
-                                       (map pretty tys)
+          do mst <- fitsOnOneLine (pretty ty)
+             case mst of
+               Nothing -> case collapseFaps ty of
+                            [] -> pretty ty
+                            tys ->
+                              prefixedLined "-> "
+                                            (map pretty tys)
+               Just st -> put st
 decl' (PatBind _ pat rhs' mbinds) =
   withCaseContext False $
     do pretty pat
@@ -1586,13 +1519,13 @@
 conDecl x = case x of
               ConDecl _ name bangty ->
                 depend (do pretty name
-                           space)
+                           unless (null bangty) space)
                        (lined (map pretty bangty))
               InfixConDecl l a f b ->
                 pretty (ConDecl l f [a,b])
               RecDecl _ name fields ->
                 depend (do pretty name
-                           write " ")
+                           space)
                        (do depend (write "{")
                                   (prefixedLined ","
                                                  (map pretty fields))
@@ -1611,8 +1544,8 @@
                        (prefixedLined ","
                                       (map (depend space . pretty) fields))
                 newline
-                write "} ")
-recDecl r = prettyNoExt r
+                write "}")
+recDecl r = prettyInternal r
 
 recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer ()
 recUpdateExpr expWriter updates = do
@@ -1637,33 +1570,16 @@
 isRecord _ = False
 
 -- | Does printing the given thing overflow column limit? (e.g. 80)
-isOverflow :: MonadState (PrintState) m => m a -> m Bool
-isOverflow p =
-  do (_,st) <- sandbox p
-     columnLimit <- getColumnLimit
-     return (psColumn st > columnLimit)
-
--- | Does printing the given thing overflow column limit? (e.g. 80)
-fitsOnOneLine :: MonadState (PrintState) m => m a -> m (Bool,PrintState)
+fitsOnOneLine :: Printer a -> Printer (Maybe PrintState)
 fitsOnOneLine p =
-  do line <- gets psLine
-     (_,st) <- sandbox p
-     columnLimit <- getColumnLimit
-     return (psLine st == line && psColumn st < columnLimit,st)
-
--- | Is the given expression a single-liner when printed?
-isSingleLiner :: MonadState (PrintState) m
-              => m a -> m Bool
-isSingleLiner p =
-  do line <- gets psLine
-     (_,st) <- sandbox p
-     return (psLine st == line)
-
-isSmall :: MonadState PrintState m => m a -> m Bool
-isSmall p =
-  do overflows <- isOverflow p
-     oneLine <- isSingleLiner p
-     return (not overflows && oneLine)
+  do st <- get
+     put st { psHardLimit = True}
+     ok <- fmap (const True) p <|> return False
+     st' <- get
+     put st
+     return (if ok
+                then Just st' { psHardLimit = psHardLimit st }
+                else Nothing)
 
 bindingGroup :: Binds NodeInfo -> Printer ()
 bindingGroup binds =
@@ -1680,25 +1596,25 @@
          -> Maybe Int64
          -> Printer ()
 infixApp e a op b indent =
-  do (fits,st) <-
-       fitsOnOneLine
-         (spaced (map (\link ->
-                         case link of
-                           OpChainExp e' -> pretty e'
-                           OpChainLink qop -> pretty qop)
-                      (flattenOpChain e)))
-     if fits
-        then put st
-        else do prettyWithIndent a
-                space
-                pretty op
-                newline
-                case indent of
-                  Nothing -> prettyWithIndent b
-                  Just col ->
-                    do indentSpaces <- getIndentSpaces
-                       column (col + indentSpaces)
-                              (prettyWithIndent b)
+  do msg <-
+          fitsOnOneLine
+            (spaced (map (\link ->
+                            case link of
+                              OpChainExp e' -> pretty e'
+                              OpChainLink qop -> pretty qop)
+                         (flattenOpChain e)))
+     case msg of
+       Nothing -> do prettyWithIndent a
+                     space
+                     pretty op
+                     newline
+                     case indent of
+                       Nothing -> prettyWithIndent b
+                       Just col ->
+                         do indentSpaces <- getIndentSpaces
+                            column (col + indentSpaces)
+                                   (prettyWithIndent b)
+       Just st -> put st
   where prettyWithIndent e' =
           case e' of
             (InfixApp _ a' op' b') ->
diff --git a/src/HIndent/Types.hs b/src/HIndent/Types.hs
--- a/src/HIndent/Types.hs
+++ b/src/HIndent/Types.hs
@@ -13,20 +13,16 @@
   ,Config(..)
   ,defaultConfig
   ,NodeInfo(..)
-  ,ComInfo(..)
-  ,ComInfoLocation(..)
+  ,NodeComment(..)
   ) where
 
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Strict (MonadState(..),StateT)
 import Control.Monad.Trans.Maybe
-import Data.Data
+import Data.ByteString.Builder
 import Data.Functor.Identity
 import Data.Int (Int64)
-import Data.ByteString.Builder
-import Language.Haskell.Exts.Comments
-import Language.Haskell.Exts.Parser
 import Language.Haskell.Exts.SrcLoc
 
 -- | A pretty printing monad.
@@ -35,47 +31,52 @@
   deriving (Applicative,Monad,Functor,MonadState PrintState,MonadPlus,Alternative)
 
 -- | The state of the pretty printer.
-data PrintState =
-  PrintState {psIndentLevel :: !Int64 -- ^ Current indentation level.
-             ,psOutput :: !Builder -- ^ The current output.
-             ,psNewline :: !Bool -- ^ Just outputted a newline?
-             ,psColumn :: !Int64 -- ^ Current column.
-             ,psLine :: !Int64 -- ^ Current line number.
-             ,psConfig :: !Config -- ^ Config which styles may or may not pay attention to.
-             ,psEolComment :: !Bool -- ^ An end of line comment has just been outputted.
-             ,psInsideCase :: !Bool -- ^ Whether we're in a case statement, used for Rhs printing.
-             ,psParseMode :: !ParseMode -- ^ Mode used to parse the original AST.
-             }
+data PrintState = PrintState
+  { psIndentLevel :: !Int64
+    -- ^ Current indentation level, i.e. every time there's a
+    -- new-line, output this many spaces.
+  , psOutput :: !Builder
+    -- ^ The current output bytestring builder.
+  , psNewline :: !Bool
+    -- ^ Just outputted a newline?
+  , psColumn :: !Int64
+    -- ^ Current column.
+  , psLine :: !Int64
+    -- ^ Current line number.
+  , psConfig :: !Config
+    -- ^ Configuration of max colums and indentation style.
+  , psInsideCase :: !Bool
+    -- ^ Whether we're in a case statement, used for Rhs printing.
+  , psHardLimit :: !Bool
+    -- ^ Bail out if we exceed current column.
+  , psEolComment :: !Bool
+  }
 
 -- | Configurations shared among the different styles. Styles may pay
 -- attention to or completely disregard this configuration.
 data Config =
   Config {configMaxColumns :: !Int64 -- ^ Maximum columns to fit code into ideally.
          ,configIndentSpaces :: !Int64 -- ^ How many spaces to indent?
-         ,configClearEmptyLines :: !Bool  -- ^ Remove spaces on lines that are otherwise empty?
          }
 
 -- | Default style configuration.
 defaultConfig :: Config
 defaultConfig =
   Config {configMaxColumns = 80
-         ,configIndentSpaces = 2
-         ,configClearEmptyLines = False}
-
--- | Information for each node in the AST.
-data NodeInfo =
-  NodeInfo {nodeInfoSpan :: !SrcSpanInfo -- ^ Location info from the parser.
-           ,nodeInfoComments :: ![ComInfo] -- ^ Comments which are attached to this node.
-           }
-  deriving (Typeable,Show,Data)
+         ,configIndentSpaces = 4}
 
--- | Comment relative locations.
-data ComInfoLocation = Before | After
-  deriving (Show,Typeable,Data,Eq)
+data NodeComment
+  = CommentSameLine String
+  | CommentAfterLine String
+  | CommentBeforeLine String
+  deriving (Show,Ord,Eq)
 
--- | Comment with some more info.
-data ComInfo =
-  ComInfo {comInfoComment :: !Comment                -- ^ The normal comment type.
-          ,comInfoLocation :: !(Maybe ComInfoLocation) -- ^ Where the comment lies relative to the node.
-          }
-  deriving (Show,Typeable,Data)
+-- | Information for each node in the AST.
+data NodeInfo = NodeInfo
+  { nodeInfoSpan :: !SrcSpanInfo -- ^ Location info from the parser.
+  , nodeInfoComments :: ![NodeComment] -- ^ Comment attached to this node.
+  }
+instance Show NodeInfo where
+  show (NodeInfo _ []) = ""
+  show (NodeInfo _ s) =
+    "{- " ++ show s ++ " -}"
diff --git a/src/main/Main.hs b/src/main/Main.hs
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -9,26 +9,27 @@
 
 module Main where
 
-import           HIndent
-import           HIndent.Types
+import           Control.Applicative
+import           Control.Exception
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Builder as S
 import qualified Data.ByteString.Lazy.Char8 as L8
-import           Control.Applicative
+import           Data.Maybe
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Version (showVersion)
 import           Descriptive
 import           Descriptive.Options
+import           Foreign.C.Error
+import           GHC.IO.Exception
+import           HIndent
+import           HIndent.Types
 import           Language.Haskell.Exts hiding (Style,style)
 import           Paths_hindent (version)
 import           System.Directory
 import           System.Environment
 import           System.IO
 import           Text.Read
-import           Control.Exception
-import           GHC.IO.Exception
-import           Foreign.C.Error
 
 -- | Main entry point.
 main :: IO ()
@@ -93,17 +94,19 @@
             (optional
                  (constant "--style" "Style to print with" () *>
                   anyString "STYLE")) <*>
-        lineLen
+        lineLen <*> tabsize
     exts = fmap getExtensions (many (prefix "X" "Language extension"))
+    tabsize =
+        fmap
+            (>>= (readMaybe . T.unpack))
+            (optional (arg "tab-size" "Tab size, default: 4"))
     lineLen =
         fmap
             (>>= (readMaybe . T.unpack))
             (optional (arg "line-length" "Desired length of lines"))
-    makeStyle s mlen =
-        case mlen of
-            Nothing -> s
-            Just len ->
-                s
-                { configMaxColumns = len
-                }
+    makeStyle s mlen tabs =
+        s
+        { configMaxColumns = fromMaybe (configMaxColumns s) mlen
+        , configIndentSpaces = fromMaybe (configIndentSpaces s) tabs
+        }
     file = fmap (fmap T.unpack) (optional (anyString "[<filename>]"))
diff --git a/src/main/Test.hs b/src/main/Test.hs
--- a/src/main/Test.hs
+++ b/src/main/Test.hs
@@ -4,6 +4,8 @@
 
 module Main where
 
+import           Data.Algorithm.Diff
+import           Data.Algorithm.DiffOutput
 import qualified Data.ByteString as S
 import           Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L
@@ -11,6 +13,7 @@
 import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.ByteString.Lazy.UTF8 as LUTF8
 import qualified Data.ByteString.UTF8 as UTF8
+import           Data.Function
 import           Data.Monoid
 import           HIndent
 import           HIndent.Types
@@ -54,9 +57,23 @@
 -- | Version of 'shouldBe' that prints strings in a readable way,
 -- better for our use-case.
 shouldBeReadable :: ByteString -> ByteString -> Expectation
-shouldBeReadable x y = shouldBe (Readable x) (Readable y)
+shouldBeReadable x y = shouldBe (Readable x (Just (diff y x))) (Readable y Nothing)
 
 -- | Prints a string without quoting and escaping.
-newtype Readable = Readable ByteString deriving (Eq)
+data Readable = Readable
+  { readableString :: ByteString
+  , readableDiff :: (Maybe String)
+  }
+instance Eq Readable where
+  (==) = on (==) readableString
 instance Show Readable where
-  show (Readable x) = "\n" ++ LUTF8.toString x
+  show (Readable x d') =
+    "\n" ++
+    LUTF8.toString x ++
+    (case d' of
+       Just d -> "\nThe diff:\n" ++ d
+       Nothing -> "")
+
+-- | A diff display.
+diff :: ByteString -> ByteString -> String
+diff x y = ppDiff (on (getGroupedDiff) (lines . LUTF8.toString) x y)