hindent 4.4.1 → 4.4.2

raw patch · 42 files changed

+1238/−256 lines, 42 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hindent.cabal +1/−1
• src/HIndent.hs +124/−25
• src/HIndent/Pretty.hs +31/−52
• src/HIndent/Styles/ChrisDone.hs +2/−1
• src/HIndent/Styles/Fundamental.hs +2/−1
• src/HIndent/Styles/Gibiansky.hs +452/−103
• src/HIndent/Styles/JohanTibell.hs +23/−2
• src/HIndent/Types.hs +4/−1
• src/main/Main.hs +0/−1
• test/Spec.hs +1/−1
• test/gibiansky/expected/11.exp +12/−11
• test/gibiansky/expected/13.exp +1/−2
• test/gibiansky/expected/18.exp +8/−6
• test/gibiansky/expected/20.exp +1/−2
• test/gibiansky/expected/21.exp +5/−4
• test/gibiansky/expected/30.exp +22/−0
• test/gibiansky/expected/31.exp +58/−0
• test/gibiansky/expected/32.exp +39/−0
• test/gibiansky/expected/33.exp +46/−0
• test/gibiansky/expected/34.exp +17/−0
• test/gibiansky/expected/35.exp +3/−0
• test/gibiansky/expected/36.exp +60/−0
• test/gibiansky/expected/37.exp +5/−0
• test/gibiansky/expected/38.exp +8/−0
• test/gibiansky/expected/39.exp +19/−0
• test/gibiansky/expected/5.exp +16/−29
• test/gibiansky/tests/11.test +3/−6
• test/gibiansky/tests/13.test +1/−2
• test/gibiansky/tests/20.test +1/−2
• test/gibiansky/tests/21.test +5/−4
• test/gibiansky/tests/30.test +25/−0
• test/gibiansky/tests/31.test +48/−0
• test/gibiansky/tests/32.test +37/−0
• test/gibiansky/tests/33.test +46/−0
• test/gibiansky/tests/34.test +17/−0
• test/gibiansky/tests/35.test +2/−0
• test/gibiansky/tests/36.test +46/−0
• test/gibiansky/tests/37.test +5/−0
• test/gibiansky/tests/38.test +9/−0
• test/gibiansky/tests/39.test +19/−0
• test/johan-tibell/expected/5.exp +7/−0
• test/johan-tibell/tests/5.test +7/−0

@@ -1,5 +1,5 @@ name:                hindent-version:             4.4.1+version:             4.4.2 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .

@@ -37,26 +37,123 @@ import           Data.Monoid import qualified Data.Text.IO as ST import           Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy as T hiding (singleton) import           Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as T import qualified Data.Text.Lazy.IO as T-import           Language.Haskell.Exts.Annotated hiding (Style,prettyPrint,Pretty,style,parse)+import           Language.Haskell.Exts.Annotated hiding (Style, prettyPrint, Pretty, style, parse)+import           Data.Function (on)+import           Data.List (groupBy, intersperse)+import           Control.Applicative ((<$>)) +data CodeBlock = HaskellSource Text+               | CPPDirectives Text+  deriving (Show, Eq)+ -- | Format the given source. reformat :: Style -> Maybe [Extension] -> Text -> Either String Builder reformat style mexts x =-  case parseModuleWithComments mode'-                               (T.unpack x) of-    ParseOk (m,comments) ->-      prettyPrint mode' style m comments-    ParseFailed _ e -> Left e-  where mode' =-          (case mexts of-             Just exts ->-               parseMode {extensions = exts}-             Nothing -> parseMode)+  mconcat . intersperse "\n" <$> mapM processBlock (cppSplitBlocks x)+  where+    processBlock :: CodeBlock -> Either String Builder+    processBlock (CPPDirectives text) = Right $ T.fromLazyText text+    processBlock (HaskellSource text) =+      let lines = lines' text+          prefix = findPrefix lines+          code = T.unpack $ unlines' $ map (stripPrefix prefix) lines+      in case parseModuleWithComments mode' code of+        ParseOk (m, comments) ->+          T.fromLazyText <$> addPrefix prefix <$> T.toLazyText <$> prettyPrint mode' style m comments+        ParseFailed _ e -> Left e +    lines' = T.split (== '\n')+    unlines' = mconcat . intersperse "\n"++    addPrefix :: Text -> Text -> Text+    addPrefix prefix = unlines' . map (prefix <>) . lines'++    stripPrefix :: Text -> Text -> Text+    stripPrefix prefix line =+      if T.null (T.dropWhile (== '\n') line)+      then line+      else fromMaybe (error "Missing expected prefix") . T.stripPrefix prefix $ line++    findPrefix :: [Text] -> Text+    findPrefix = takePrefix False . findSmallestPrefix . dropNewlines++    dropNewlines :: [Text] -> [Text]+    dropNewlines = filter (not . T.null . T.dropWhile (== '\n'))++    takePrefix :: Bool -> Text -> Text+    takePrefix bracketUsed txt =+      case T.uncons txt of+        Nothing -> ""+        Just ('>', txt') -> if not bracketUsed+                              then T.cons '>' (takePrefix True txt')+                              else ""+        Just (c, txt') -> if c == ' ' || c == '\t'+                            then T.cons c (takePrefix bracketUsed txt')+                            else ""+++    findSmallestPrefix :: [Text] -> Text+    findSmallestPrefix [] = ""+    findSmallestPrefix ("":_) = ""+    findSmallestPrefix (p:ps) = +      let first = T.head p+          startsWithChar c x  = T.length x > 0 && T.head x == c+      in if all (startsWithChar first) ps+           then T.cons first (findSmallestPrefix (T.tail p : map T.tail ps))+           else ""++    mode' =+      case mexts of+        Just exts -> parseMode { extensions = exts }+        Nothing   -> parseMode++-- | Break a Haskell code string into chunks, using CPP as a delimiter.+-- Lines that start with '#if', '#end', or '#else' are their own chunks, and+-- also act as chunk separators. For example, the code+--+-- > #ifdef X+-- > x = X+-- > y = Y+-- > #else+-- > x = Y+-- > y = X+-- > #endif+--+-- will become five blocks, one for each CPP line and one for each pair of declarations.+cppSplitBlocks :: Text -> [CodeBlock]+cppSplitBlocks inp =+  modifyLast (inBlock (`T.append` trailing)) .+  map (classify . mconcat . intersperse "\n") .+  groupBy ((==) `on` cppLine) .+  T.lines $ inp+  where+    cppLine :: Text -> Bool+    cppLine src = any (`T.isPrefixOf` src) ["#if", "#end", "#else", "#define", "#undef"]++    classify :: Text -> CodeBlock+    classify text = if cppLine text+                    then CPPDirectives text+                    else HaskellSource text++    -- Hack to work around some parser issues in haskell-src-exts: Some pragmas+    -- need to have a newline following them in order to parse properly, so we include+    -- the trailing newline in the code block if it existed.+    trailing :: Text+    trailing = if T.isSuffixOf "\n" inp then "\n" else ""++    modifyLast :: (a -> a) -> [a] -> [a]+    modifyLast _ []  = []+    modifyLast f [x] = [f x]+    modifyLast f (x:xs) = x : modifyLast f xs++    inBlock :: (Text -> Text) -> CodeBlock -> CodeBlock+    inBlock f (HaskellSource txt) = HaskellSource (f txt)+    inBlock _ dir = dir+ -- | Print the module. prettyPrint :: ParseMode             -> Style@@ -65,27 +162,29 @@             -> Either a Builder prettyPrint mode' style m comments =   let (cs,ast) =-        annotateComments (fromMaybe m (applyFixities baseFixities m))-                         comments-  in Right (runPrinterStyle-              mode'-              style-              -- 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)-                        (reverse cs)-                  pretty ast))+        annotateComments (fromMaybe m $ applyFixities baseFixities m) comments+      csComments = map comInfoComment cs+  in case style of+      style@(Style { styleCommentPreprocessor = preprocessor }) ->+        Right (runPrinterStyle+                  mode'+                  style+                  -- 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 comments <- preprocessor (reverse csComments)+                      mapM_ (printComment Nothing) comments+                      pretty ast))  -- | Pretty print the given printable thing. runPrinterStyle :: ParseMode -> Style -> (forall s. Printer s ()) -> Builder-runPrinterStyle mode' (Style _name _author _desc st extenders config) m =+runPrinterStyle mode' (Style _name _author _desc st extenders config preprocessor) m =   maybe (error "Printer failed with mzero call.")         psOutput         (runIdentity            (runMaybeT (execStateT                          (runPrinter m)-                         (PrintState 0 mempty False 0 1 st extenders config False False mode'))))+                         (PrintState 0 mempty False 0 1 st extenders config False False mode' preprocessor))))  -- | Parse mode, includes all extensions, doesn't assume any fixities. parseMode :: ParseMode

@@ -100,12 +100,12 @@            depend              (case listToMaybe (mapMaybe (makePrinter s) es) of                 Just (Printer m) ->-                  modify (\s ->-                            fromMaybe s-                                      (runIdentity (runMaybeT (execStateT m s))))+                  modify (\s' ->+                            fromMaybe s'+                                      (runIdentity (runMaybeT (execStateT m s'))))                 Nothing -> prettyNoExt a)              (printComments After a)-  where makePrinter s (Extender f) =+  where makePrinter _ (Extender f) =           case cast a of             Just v -> Just (f v)             Nothing -> Nothing@@ -121,29 +121,35 @@ -- | Print comments of a node. printComments :: (Pretty ast,MonadState (PrintState s) m)               => ComInfoLocation -> ast NodeInfo -> m ()-printComments loc' ast =-  forM_ comments $ \comment ->-    when (comInfoLocation comment == Just loc') $ do-      -- Preceeding comments must have a newline before them.-      hasNewline <- gets psNewline-      when (not hasNewline && loc' == Before) newline+printComments loc' ast = do+  preprocessor <- gets psCommentPreprocessor -      printComment (Just $ srcInfoSpan $ nodeInfoSpan info) comment+  let correctLocation comment = comInfoLocation comment == Just loc'+      commentsWithLocation = filter correctLocation (nodeInfoComments info)+  comments <- preprocessor $ 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-        comments = nodeInfoComments info+   -- | Pretty print a comment.-printComment :: MonadState (PrintState s) m => Maybe SrcSpan -> ComInfo -> m ()-printComment mayNodespan (ComInfo (Comment inline cspan str) _) =+printComment :: MonadState (PrintState s) 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 --                               srcSpanEndColumn nodespan+                               max 1 (srcSpanEndColumn nodespan)             replicateM_ neededSpaces space        Nothing -> return ()+      if inline         then do write "{-"                 string str@@ -857,43 +863,16 @@                     (depend (write "=")                             (prefixedLined "|"                                            (map (depend space . pretty) xs)))-decl GDataDecl{} =-  error "FIXME: No implementation for GDataDecl."-decl DataFamDecl{} =-  error "FIXME: No implementation for DataFamDecl."-decl TypeInsDecl{} =-  error "FIXME: No implementation for TypeInsDecl."-decl DataInsDecl{} =-  error "FIXME: No implementation for DataInsDecl."-decl GDataInsDecl{} =-  error "FIXME: No implementation for GDataInsDecl."-decl DerivDecl{} =-  error "FIXME: No implementation for DerivDecl."-decl ForImp{} =-  error "FIXME: No implementation for ForImp."-decl ForExp{} =-  error "FIXME: No implementation for ForExp."-decl RulePragmaDecl{} =-  error "FIXME: No implementation for RulePragmaDecl."-decl DeprPragmaDecl{} =-  error "FIXME: No implementation for DeprPragmaDecl."-decl InlineSig{} =-  error "FIXME: No implementation for InlineSig."-decl InlineConlikeSig{} =-  error "FIXME: No implementation for InlineConlikeSig."-decl SpecSig{} =-  error "FIXME: No implementation for SpecSig."-decl SpecInlineSig{} =-  error "FIXME: No implementation for SpecInlineSig."-decl InstSig{} =-  error "FIXME: No implementation for InstSig."-decl ClosedTypeFamDecl{} =-  error "FIXME: No implementation for ClosedTypeFamDecl."-decl x@WarnPragmaDecl{} = pretty' x-decl x@MinimalPragma{} = pretty' x-decl x@AnnPragma{} = pretty' x-decl x@InfixDecl{} = pretty' x-decl x@DefaultDecl{} = pretty' x++decl (InlineSig _ inline _ name) = do+  write "{-# "++  unless inline $ write "NO"+  write "INLINE "+  pretty name++  write " #-}"+decl x = pretty' x  instance Pretty Deriving where   prettyInternal (Deriving _ heads) =

@@ -53,7 +53,8 @@            ,Extender decl]         ,styleDefConfig =            defaultConfig {configMaxColumns = 80-                         ,configIndentSpaces = 2}}+                         ,configIndentSpaces = 2}+        ,styleCommentPreprocessor = return}  -------------------------------------------------------------------------------- -- Extenders

@@ -21,4 +21,5 @@         ,styleDescription = "This style adds no extensions to the built-in printer."         ,styleInitialState = State         ,styleExtenders = []-        ,styleDefConfig = def}+        ,styleDefConfig = def+        ,styleCommentPreprocessor = return}

@@ -5,27 +5,37 @@  import           Data.Foldable import           Control.Applicative ((<$>))-import           Control.Monad (unless, when, replicateM_)-import           Control.Monad.State (gets, get, put)-import           Data.Maybe (isNothing)+import           Data.Maybe+import           Data.List (unfoldr, isPrefixOf)+import           Control.Monad.Trans.Maybe+import           Data.Functor.Identity+import           Control.Monad.State.Strict hiding (state, State, forM_)+import           Data.Typeable  import           HIndent.Pretty import           HIndent.Types  import           Language.Haskell.Exts.Annotated.Syntax import           Language.Haskell.Exts.SrcLoc+import           Language.Haskell.Exts.Pretty (prettyPrint) import           Language.Haskell.Exts.Comments-import           Prelude hiding (exp, all, mapM_, minimum, and, maximum)+import           Prelude hiding (exp, all, mapM_, minimum, and, maximum, concatMap, or, any)  -- | Empty state.-data State = State { gibianskyForceSingleLine :: Bool }+data State = State { gibianskyForceSingleLine :: Bool, gibianskyLetBind :: Bool } +userGets :: (State -> a) -> Printer State a+userGets f = gets (f . psUserState)++userModify :: (State -> State) -> Printer State ()+userModify f = modify (\s -> s { psUserState = f (psUserState s) })+ -- | The printer style. gibiansky :: Style gibiansky = Style { styleName = "gibiansky"                   , styleAuthor = "Andrew Gibiansky"                   , styleDescription = "Andrew Gibiansky's style"-                  , styleInitialState = State { gibianskyForceSingleLine = False }+                  , styleInitialState = State { gibianskyForceSingleLine = False, gibianskyLetBind = False }                   , styleExtenders = [ Extender imp                                      , Extender modl                                      , Extender context@@ -35,6 +45,7 @@                                      , Extender rhss                                      , Extender guardedRhs                                      , Extender decls+                                     , Extender stmts                                      , Extender condecls                                      , Extender alt                                      , Extender moduleHead@@ -42,20 +53,142 @@                                      , Extender fieldUpdate                                      , Extender pragmas                                      , Extender pat+                                     , Extender qualConDecl                                      ]                   , styleDefConfig = defaultConfig { configMaxColumns = 100                                                    , configIndentSpaces = indentSpaces                                                    , configClearEmptyLines = True                                                    }+                  , styleCommentPreprocessor = commentPreprocessor                   } +-- Field accessor for Comment.+commentContent :: Comment -> String+commentContent (Comment _ _ content) = content++-- Field accessor for Comment.+commentSrcSpan :: Comment -> SrcSpan+commentSrcSpan (Comment _ srcSpan _) = srcSpan++commentPreprocessor :: MonadState (PrintState s) m => [Comment] -> m [Comment]+commentPreprocessor cs = do+  config <- gets psConfig+  col <- getColumn+  return $ go (fromIntegral col) config cs+  +  where+   go currentColumn config = concatMap mergeGroup . groupComments Nothing []+    where+      -- Group comments into blocks.+      -- A comment block is the list of comments that are on consecutive lines,+      -- and do not have an empty comment in between them. Empty comments are those with only whitespace.+      -- Empty comments are in their own group.+      groupComments :: Maybe Int -> [Comment] -> [Comment] -> [[Comment]]+      groupComments nextLine accum (comment@(Comment multiline srcSpan str):comments)+        | separateCommentCondition = useAsSeparateCommentGroup+        | beginningOfUnprocessed str =+            let (unprocessedLines, postUnprocessed) = span unprocessed comments+                (endingLine, remLines) = case postUnprocessed of+                    x:xs -> ([x], xs)+                    [] -> ([], [])+                separateCommentGroups = comment : unprocessedLines ++ endingLine+            in currentGroupAsList ++ map (: []) separateCommentGroups ++ groupComments Nothing [] remLines+        | isNothing nextLine || Just (srcSpanStartLine srcSpan) == nextLine = groupComments nextLine' (comment:accum) comments+        | otherwise = currentGroupAsList ++ groupComments (Just $ srcSpanStartLine srcSpan + 1) [comment] comments+        where+          separateCommentCondition = or [multiline, isWhitespace str, "  " `isPrefixOf` str, " >" `isPrefixOf` str]+          useAsSeparateCommentGroup = currentGroupAsList ++ [comment] : groupComments nextLine' [] comments+          nextCommentStartLine = srcSpanStartLine $ commentSrcSpan $ head comments+          currentGroupAsList | null accum = []+                            | otherwise = [reverse accum]+          nextLine' = +            case nextLine of+              Just x -> Just (x + 1)+              Nothing -> Just nextCommentStartLine+      groupComments _ [] [] = []+      groupComments _ accum [] = [reverse accum]++      beginningOfUnprocessed :: String -> Bool+      beginningOfUnprocessed str = any (`isPrefixOf` str) ["@", " @", "  @"]++      unprocessed :: Comment -> Bool+      unprocessed (Comment True _ _) = False+      unprocessed (Comment _ _ str) = not $ beginningOfUnprocessed str++      isWhitespace :: String -> Bool+      isWhitespace = all (\x -> x == ' ' || x == '\t')++      commentLen :: Int+      commentLen = length ("--" :: String)++      -- Merge a group of comments into one comment.+      mergeGroup :: [Comment] -> [Comment]+      mergeGroup [] = error "Empty comment group"+      mergeGroup comments@[Comment True _ _] = comments+      mergeGroup comments = +        let +            firstSrcSpan = commentSrcSpan $ head comments+            firstLine = srcSpanStartLine firstSrcSpan+            firstCol = srcSpanStartColumn firstSrcSpan++            columnDelta = firstCol - currentColumn+            maxStartColumn = maximum (map (srcSpanStartColumn . commentSrcSpan) comments)++            lineLen = fromIntegral (configMaxColumns config) - maxStartColumn - commentLen + columnDelta+            content = breakCommentLines lineLen $ unlines (map commentContent comments)+            srcSpanLines = map (firstLine +) [0 .. length content - 1]+            srcSpans = map (\linum -> firstSrcSpan { srcSpanStartLine = linum, srcSpanEndLine = linum, srcSpanStartColumn = maxStartColumn }) srcSpanLines+        in zipWith (Comment False) srcSpans content+++-- | Break a comment string into lines of a maximum character length.+-- Each line starts with a space, mirroring the traditional way of writing comments:+--+--   -- Hello+--   -- Note the space after the '-'+breakCommentLines :: Int -> String -> [String]+breakCommentLines maxLen str+  -- If there's no way to do this formatting, just give up+  | any ((maxLen <) . length) (words str) = [str]++  -- If we already have a line of the appropriate length, leave it alone. This allows us to format+  -- stuff ourselves in some cases.+  | length (lines str) == 1 && length str <= maxLen = [dropTrailingNewlines str]++  | otherwise = unfoldr unfolder (words str)+  where+    -- Generate successive lines, consuming the words iteratively.+    unfolder :: [String] -> Maybe (String, [String])+    unfolder [] = Nothing+    unfolder ws = Just $ go maxLen [] ws+      where+        go :: Int                -- Characters remaining on the line to be used+           -> [String]           -- Accumulator: The words used so far on this line+           -> [String]           -- Unused words+           -> (String, [String]) -- (Generated line, remaining words)+        go remainingLen taken remainingWords =+          case remainingWords of+            -- If no more words remain, we're done+            [] -> (generatedLine, [])+            word:remWords ->+              -- If the next word doesn't fit on this line, line break+              let nextRemaining = remainingLen - length word - 1+              in if nextRemaining < 0+                   then (generatedLine, remainingWords)+                   else go nextRemaining (word : taken) remWords+          where+            generatedLine = ' ' : unwords (reverse taken)++dropTrailingNewlines :: String -> String+dropTrailingNewlines = reverse . dropWhile (== '\n') . reverse+ -- | Number of spaces to indent by. indentSpaces :: Integral a => a indentSpaces = 2  -- | Printer to indent one level. indentOnce :: Printer s ()-indentOnce = replicateM_ indentSpaces $ write " "+indentOnce = replicateM_ indentSpaces space  -- | How many exports to format in a single line. -- If an export list has more than this, it will be formatted as multiple lines.@@ -100,21 +233,42 @@    onSeparateLines imps   unless (null imps || null decls) (newline >> newline)-  onSeparateLines decls++  unless (null decls) $ do+    forM_ (init decls) $ \decl -> do+      pretty decl+      newline+      unless (skipFollowingNewline decl) newline+    pretty (last decls) modl m = prettyNoExt m +skipFollowingNewline :: Decl l -> Bool+skipFollowingNewline TypeSig{} = True+skipFollowingNewline InlineSig{} = True+skipFollowingNewline AnnPragma{} = True+skipFollowingNewline MinimalPragma{} = True+skipFollowingNewline _ = False+ -- | Format pragmas differently (language pragmas). pragmas :: Extend ModulePragma pragmas (LanguagePragma _ names) = do   write "{-# LANGUAGE "   inter (write ", ") $ map pretty names   write " #-}"+pragmas (OptionsPragma _ mtool opt) = do+  write "{-# OPTIONS"+  forM_ mtool $ \tool -> do+    write "_"+    string $ prettyPrint tool+  string opt+  write "#-}" pragmas p = prettyNoExt p  -- | Format patterns. pat :: Extend Pat pat (PTuple _ boxed pats) = writeTuple boxed pats pat (PList _ pats) = singleLineList pats+pat (PRec _ name fields) = recUpdateExpr fields (pretty name) (map prettyCommentCallbacks fields) pat p = prettyNoExt p  -- | Format import statements.@@ -130,10 +284,36 @@     write " as "     pretty name -  forM_ importSpecs $ \speclist -> do-    write " "-    pretty speclist+  forM_ importSpecs $ \(ImportSpecList _ importHiding specs) -> do+    space+    when importHiding $ write "hiding "+    depend (write "(") $ do+      case specs of+        [] -> return ()+        x:xs -> do+          pretty x+          forM_ xs $ \spec -> do+            write ","+            col <- getColumn+            len <- prettyColLength spec+            maxColumns <- configMaxColumns <$> gets psConfig+            if col + len > maxColumns +              then newline+              else space +            pretty spec+      write ")"++-- | Return the number of columns between the start and end of a printer.+-- Note that if it breaks lines, the line break is not counted; only column is used.+-- So you probably only want to use this for single-line printers.+prettyColLength :: (Integral a, Pretty ast) => ast NodeInfo -> Printer State a+prettyColLength x = fst <$> sandbox (do+  col <- getColumn+  pretty x+  col' <- getColumn+  return $ fromIntegral $ max (col' - col) 0)+ -- | Format contexts with spaces and commas between class constraints. context :: Extend Context context (CxTuple _ asserts) =@@ -222,16 +402,29 @@ exprs exp@Case{} = caseExpr exp exprs exp@LCase{} = lambdaCaseExpr exp exprs exp@If{} = ifExpr exp-exprs (RecUpdate _ exp updates) = recUpdateExpr (pretty exp) updates-exprs (RecConstr _ qname updates) = recUpdateExpr (pretty qname) updates+exprs exp@MultiIf{} = multiIfExpr exp+exprs (RecUpdate _ exp updates) = recUpdateExpr updates (pretty exp) (map prettyCommentCallbacks updates)+exprs (RecConstr _ qname updates) = recUpdateExpr updates (pretty qname) (map prettyCommentCallbacks updates) exprs (Tuple _ _ exps) = parens $ inter (write ", ") $ map pretty exps exprs exp = prettyNoExt exp +multiIfExpr :: Exp NodeInfo -> Printer State ()+multiIfExpr (MultiIf _ alts) =+  withCaseContext True $+    depend (write "if ") $+      onSeparateLines' (depend (write "|") . pretty) alts+multiIfExpr _ = error "Not a multi if"+ letExpr :: Exp NodeInfo -> Printer State () letExpr (Let _ binds result) = do   cols <- depend (write "let ") $ do             col <- getColumn++            oldLetBind <- userGets gibianskyLetBind+            userModify (\s -> s { gibianskyLetBind = True })             writeWhereBinds binds+            userModify (\s -> s { gibianskyLetBind = oldLetBind })+             return $ col - 4   column cols $ do     newline@@ -241,6 +434,8 @@  keepingColumn :: Printer State () -> Printer State () keepingColumn printer = do+  eol <- gets psEolComment+  when eol newline   col <- getColumn   ind <- gets psIndentLevel   column (max col ind) printer@@ -304,7 +499,7 @@ doExpr (Do _ stmts) = do   write "do"   newline-  indented 2 $ onSeparateLines stmts+  indented indentSpaces $ onSeparateLines stmts doExpr _ = error "Not a do"  listExpr :: Exp NodeInfo -> Printer State ()@@ -332,14 +527,16 @@ dollarExpr :: Exp NodeInfo -> Printer State () dollarExpr (InfixApp _ left op right) = do   pretty left-  write " "+  space   pretty op   if needsNewline right     then do       newline-      depend indentOnce $ pretty right+      col <- getColumn+      ind <- gets psIndentLevel+      column (max col ind + indentSpaces) $ pretty right     else do-      write " "+      space       pretty right    where@@ -366,7 +563,7 @@     multiLine :: Exp NodeInfo -> Exp NodeInfo -> [Exp NodeInfo] -> Printer State ()     multiLine first second rest = do       pretty first-      depend (write " ") $ do+      depend space $ do         write "<$> "         pretty second         forM_ rest $ \val -> do@@ -419,10 +616,15 @@   write "\\"   spaced $ map pretty pats   write " ->"-  attemptSingleLine (write " " >> pretty exp) $ do-    newline-    indentOnce-    pretty exp+  if any isBefore $ nodeInfoComments $ ann exp+    then multi+    else attemptSingleLine (space >> pretty exp) multi+      +  where multi = do+         newline+         indented indentSpaces $ pretty exp++        isBefore com = comInfoLocation com == Just Before lambdaExpr _ = error "Not a lambda"  caseExpr :: Exp NodeInfo -> Printer State ()@@ -445,7 +647,7 @@ ifExpr :: Exp NodeInfo -> Printer State () ifExpr (If _ cond thenExpr elseExpr) =   depend (write "if") $ do-    write " "+    space     pretty cond     newline     write "then "@@ -470,10 +672,12 @@       first:rest -> do         printComments Before first         prettyPr first+        printComments After first         forM_ (zip alts rest) $ \(prev, cur) -> do           replicateM_ (max 1 $ lineDelta cur prev) newline           printComments Before cur           prettyPr cur+          printComments After cur    where     isSingle :: Alt NodeInfo -> Printer State Bool@@ -482,11 +686,18 @@                                  line <- gets psLine                                  pretty alt'                                  line' <- gets psLine-                                 return $ line == line')+                                 return $ not (isGuarded (altRhs alt')) && line == line')      altPattern :: Alt l -> Pat l     altPattern (Alt _ p _ _) = p +    altRhs :: Alt l -> Rhs l+    altRhs (Alt _ _ r _) = r++    isGuarded :: Rhs l -> Bool+    isGuarded GuardedRhss{} = True+    isGuarded UnGuardedRhs{} = False+     patternLen :: Pat NodeInfo -> Printer State Int     patternLen pat = fromIntegral <$> fst <$> sandbox                                                 (do@@ -508,51 +719,111 @@        case galts of         UnGuardedRhs{} -> pretty galts-        GuardedRhss{}  -> indented indentSpaces $ pretty galts+        GuardedRhss{}  -> do+          newline+          indented indentSpaces $ pretty galts        --  Optional where clause!       forM_ mbinds $ \binds -> do         newline         indented indentSpaces $ depend (write "where ") (pretty binds) +prettyCommentCallbacks :: (Pretty ast,MonadState (PrintState s) m) => ast NodeInfo -> (ComInfoLocation -> m ()) -> m ()+prettyCommentCallbacks a f =+  do st <- get+     case st of+       PrintState{psExtenders = es,psUserState = s} ->+         do+           printComments Before a+           f Before+           depend+             (case listToMaybe (mapMaybe (makePrinter s) es) of+                Just (Printer m) ->+                  modify (\s' ->+                            fromMaybe s'+                                      (runIdentity (runMaybeT (execStateT m s'))))+                Nothing -> prettyNoExt a)+             (f After >> printComments After a)+  where makePrinter _ (Extender f) =+          case cast a of+            Just v -> Just (f v)+            Nothing -> Nothing+        makePrinter s (CatchAll f) = f s a -recUpdateExpr :: Printer State () -> [FieldUpdate NodeInfo] -> Printer State ()-recUpdateExpr expWriter updates = do-  expWriter-  write " "-  if null updates-    then write "{}"-    else attemptSingleLine single mult +recUpdateExpr :: Foldable f => [f NodeInfo] -> Printer State () -> [(ComInfoLocation -> Printer State ()) -> Printer State ()] -> Printer State ()+recUpdateExpr ast expWriter updates+  | null updates = do+      expWriter+      write "{}"+  | any hasComments ast = mult+  | otherwise = attemptSingleLine single mult+   where     single = do-      write "{ "-      inter (write ", ") $ map pretty updates+      expWriter+      write " { "+      inter (write ", ") updates'       write " }"     mult = do-      col <- getColumn-      column col $ do+      expWriter+      newline+      indented indentSpaces $ keepingColumn $ do         write "{ "-        pretty (head updates)+        head updates'         forM_ (tail updates) $ \update -> do           newline-          write ", "-          pretty update+          update commaAfterComment         newline         write "}" +    updates' = map ($ const $ return ()) updates++commaAfterComment :: ComInfoLocation -> Printer State ()+commaAfterComment loc = case loc of+  Before -> write ", "+  After -> return ()+ rhss :: Extend Rhs rhss (UnGuardedRhs rhsLoc exp) = do-  write " "-  rhsSeparator-  if onNextLine exp-    then indented indentSpaces $ do-      newline-      pretty exp-    else do-      space-      pretty exp+  letBind <- userGets gibianskyLetBind+  let exp'+        | lineBreakAfterRhs rhsLoc exp =+            indented indentSpaces $ do+              newline+              pretty exp+        | letBind =+            depend space (pretty exp)+        | otherwise = space >> pretty exp+  if letBind+    then depend (space >> rhsSeparator) exp'+    else space >> rhsSeparator >> exp'+rhss (GuardedRhss _ rs) =+  flip onSeparateLines' rs $ \a@(GuardedRhs rhsLoc stmts exp) -> do+    let manyStmts = length stmts > 1+        remainder = do+          if manyStmts then newline else space+          rhsSeparator+          if not manyStmts && lineBreakAfterRhs rhsLoc exp+            then newline >> indented indentSpaces (pretty exp)+            else space >> pretty exp+        writeStmts = +          case stmts of+            x:xs -> do+              pretty x+              forM_ xs $ \x -> write "," >> newline >> pretty x+            [] -> return () +    printComments Before a+    if manyStmts+      then do +        depend (write "| ") writeStmts+        remainder+      else+        depend (write "| ") $ writeStmts >> remainder++lineBreakAfterRhs :: NodeInfo -> Exp NodeInfo -> Bool+lineBreakAfterRhs rhsLoc exp = onNextLine exp   where     -- Cannot use lineDelta because we need to look at rhs start line, not end line     prevLine = srcSpanStartLine . srcInfoSpan . nodeInfoSpan $ rhsLoc@@ -562,64 +833,95 @@     onNextLine Let{} = True     onNextLine Case{} = True     onNextLine _ = emptyLines > 0-rhss (GuardedRhss _ rs) =-  lined $ flip map rs $ \a@(GuardedRhs _ stmts exp) -> do-    printComments Before a-    depend (write "| ") $ do-      inter (write ", ") $ map pretty stmts-      rhsRest exp  guardedRhs :: Extend GuardedRhs guardedRhs (GuardedRhs _ stmts exp) = do   indented 1 $ prefixedLined "," (map (\p -> space >> pretty p) stmts)+  space   rhsRest exp  rhsRest :: Pretty ast => ast NodeInfo -> Printer State () rhsRest exp = do-  write " "   rhsSeparator-  write " "+  space   pretty exp +stmts :: Extend Stmt+stmts (LetStmt _ binds) = depend (write "let ") (writeWhereBinds binds)+stmts stmt = prettyNoExt stmt+ decls :: Extend Decl decls (DataDecl _ dataOrNew Nothing declHead constructors mayDeriving) = do-  pretty dataOrNew-  write " "-  pretty declHead-  case constructors of-    [] -> return ()-    [x] -> do-      write " = "-      pretty x-    (x:xs) ->-      depend (write " ") $ do-        write "= "+  depend (pretty dataOrNew >> space) $ do+    pretty declHead+    case constructors of+      [] -> return ()+      [x] -> do+        write " ="         pretty x-        forM_ xs $ \constructor -> do-          newline-          write "| "-          pretty constructor+      (x:xs) ->+        depend space $ do+          write "="+          pretty x+          forM_ xs $ \constructor -> do+            newline+            write "|"+            pretty constructor    forM_ mayDeriving $ \deriv -> do     newline     indented indentSpaces $ pretty deriv decls (PatBind _ pat rhs mbinds) = funBody [pat] rhs mbinds decls (FunBind _ matches) =-  lined $ flip map matches $ \match -> do-    (name, pat, rhs, mbinds) <- case match of-                                  Match _ name pat rhs mbinds -> return (name, pat, rhs, mbinds)+  flip onSeparateLines' matches $ \match -> do+    printComments Before match+    (writeName, pat, rhs, mbinds) <- case match of+                                  Match _ name pat rhs mbinds -> return (pretty name, pat, rhs, mbinds)                                   InfixMatch _ left name pat rhs mbinds -> do                                     pretty left-                                    write " "-                                    return (name, pat, rhs, mbinds)--    case name of-      Symbol _ name' -> string name'-      name' -> pretty name'-    write " "+                                    space+                                    let writeName = case name of+                                          Symbol _ name' -> string name'+                                          Ident _ name' -> do+                                            write "`"+                                            string name'+                                            write "`"+                                    return (writeName, pat, rhs, mbinds)+    writeName+    space     funBody pat rhs mbinds+decls (ClassDecl _ ctx dhead fundeps mayDecls) = do+  let decls = fromMaybe [] mayDecls+      noDecls = null decls++  -- Header+  depend (write "class ") $+    depend (maybeCtx ctx) $+      depend (pretty dhead >> space) $+        depend (unless (null fundeps) (write " | " >> commas (map pretty fundeps))) $+          unless noDecls (write "where")++  -- Class method declarations+  unless noDecls $ do+    newline+    indentSpaces <- getIndentSpaces+    indented indentSpaces (onSeparateLines decls) decls decl = prettyNoExt decl +qualConDecl :: Extend QualConDecl+qualConDecl (QualConDecl _ tyvars ctx d) =+  depend (unless (null (fromMaybe [] tyvars))+                  (do write " forall "+                      spaced (map pretty (fromMaybe [] tyvars))+                      write ". "))+          (depend (maybeCtx' ctx)+                  (pretty d))+  where+    maybeCtx' = maybe (return ())+                      (\p ->+                        pretty p >>+                        write " =>")+ funBody :: [Pat NodeInfo] -> Rhs NodeInfo -> Maybe (Binds NodeInfo) -> Printer State () funBody pat rhs mbinds = do   spaced $ map pretty pat@@ -649,13 +951,43 @@  -- Print all the ASTs on separate lines, respecting user spacing. onSeparateLines :: (Pretty ast, Annotated ast) => [ast NodeInfo] -> Printer State ()-onSeparateLines vals@(first:rest) = do-  pretty first-  forM_ (zip vals rest) $ \(prev, cur) -> do+onSeparateLines = onSeparateLines' pretty++onSeparateLines' :: Annotated ast => (ast NodeInfo -> Printer State ()) -> [ast NodeInfo] -> Printer State ()+onSeparateLines' _ [] = return ()+onSeparateLines' pretty' vals = do+  let vals' = map (amap fixSpans) vals+      (first:rest) = vals'++  +  pretty' first+  forM_ (zip vals' rest) $ \(prev, cur) -> do     replicateM_ (max 1 $ lineDelta cur prev) newline-    pretty cur-onSeparateLines [] = return ()+    pretty' cur +fixSpans :: NodeInfo -> NodeInfo+fixSpans info =+  let infoSpan = nodeInfoSpan info+      srcSpan = srcInfoSpan infoSpan++      points = srcInfoPoints infoSpan+      lastPt = last points++      prevLastPt = last (init points)+      prevPtEnd = (srcSpanEndLine prevLastPt, srcSpanEndColumn prevLastPt)++      lastPtEndLoc = (srcSpanEndLine lastPt, srcSpanEndColumn lastPt)+      invalidLastPt = srcSpanStartLine lastPt == srcSpanEndLine lastPt &&+                      srcSpanStartColumn lastPt > srcSpanEndColumn lastPt++      infoEndLoc = (srcSpanEndLine srcSpan, srcSpanEndColumn srcSpan)+  in if length points > 1 && lastPtEndLoc == infoEndLoc && invalidLastPt+       then info { nodeInfoSpan = infoSpan { srcInfoSpan = setEnd srcSpan prevPtEnd } }+       else info+  where+    setEnd (SrcSpan fname startL startC _ _) (endL, endC) = SrcSpan fname startL startC endL endC++ astStartLine :: Annotated ast => ast NodeInfo -> Int astStartLine decl =   let info = ann decl@@ -672,27 +1004,44 @@  condecls :: Extend ConDecl condecls (ConDecl _ name bangty) =-  depend (pretty name) $+  depend (space >> pretty name) $     forM_ bangty $ \ty -> space >> pretty ty-condecls (RecDecl _ name fields) =-  depend (pretty name >> space) $ do-    write "{ "-    case fields of-      [] -> return ()-      [x] -> do-        pretty x-        eol <- gets psEolComment-        unless eol space-      first:rest -> do-        pretty first+condecls decl@(RecDecl _ name fields) = if hasComments decl+                                        then multiRec+                                        else attemptSingleLine singleRec multiRec+  where+    singleRec = space >> depend (pretty name >> space) recBody+    multiRec = do+      newline+      indented indentSpaces $ keepingColumn $ do+        pretty name         newline+        indented indentSpaces recBody++    recBody = do+      write "{ "+      writeFields fields+      write "}"++    writeFields [] = return ()+    writeFields [x] = do+      pretty x+      eol <- gets psEolComment+      unless eol space+    writeFields (first:rest) = do+        singleLine <- gets (gibianskyForceSingleLine . psUserState)++        pretty first+        unless singleLine newline         forM_ rest $ \field -> do-          comma-          space-          pretty field-          newline-    write "}"+          prettyCommentCallbacks field commaAfterComment+          unless singleLine newline++        when singleLine space condecls other = prettyNoExt other++hasComments :: Foldable ast => ast NodeInfo -> Bool+hasComments = any (not . null . nodeInfoComments)  alt :: Extend Alt alt (Alt _ p rhs mbinds) = do

@@ -44,6 +44,8 @@         ,styleInitialState = State         ,styleExtenders =            [Extender decl+           ,Extender context+           ,Extender typ            ,Extender conDecl            ,Extender exp            ,Extender guardedRhs@@ -53,7 +55,8 @@            ]         ,styleDefConfig =            defaultConfig {configMaxColumns = 80-                         ,configIndentSpaces = 4}}+                         ,configIndentSpaces = 4}+        ,styleCommentPreprocessor = return}  -------------------------------------------------------------------------------- -- Extenders@@ -221,11 +224,29 @@ exp (RecConstr _ qname updates) = recUpdateExpr (pretty qname) updates exp e = prettyNoExt e +-- | Format contexts with spaces and commas between class constraints.+context :: Context NodeInfo -> Printer s ()+context (CxTuple _ asserts) =+  parens $ inter (comma >> space) $ map pretty asserts+context ctx = prettyNoExt ctx++unboxParens :: MonadState (PrintState s) m => m a -> m a+unboxParens p =+  depend (write "(# ")+         (do v <- p+             write " #)"+             return v)++typ :: Type NodeInfo -> Printer s ()+typ (TyTuple _ Boxed types) = parens $ inter (write ", ") $ map pretty types+typ (TyTuple _ Unboxed types) = unboxParens $ inter (write ", ") $ map pretty types+typ ty = prettyNoExt ty+ -- | Specially format records. Indent where clauses only 2 spaces. decl :: Decl NodeInfo -> Printer s () -- | Pretty print type signatures like ----- foo :: (Show x,Read x)+-- foo :: (Show x, Read x) --     => (Foo -> Bar) --     -> Maybe Int --     -> (Char -> X -> Y)

@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}  -- | All types. @@ -50,10 +51,11 @@              ,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.+             ,psCommentPreprocessor :: forall m. MonadState (PrintState s) m => [Comment] -> m [Comment] -- ^ Preprocessor applied to comments on an AST before printing.              }  instance Eq (PrintState s) where-  PrintState ilevel out newline col line _ _ _ eolc inc _ == PrintState ilevel' out' newline' col' line' _ _ _ eolc' inc' _ =+  PrintState ilevel out newline col line _ _ _ eolc inc _pm _ == PrintState ilevel' out' newline' col' line' _ _ _ eolc' inc' _pm' _ =     (ilevel,out,newline,col,line,eolc, inc) == (ilevel',out',newline',col',line',eolc', inc')  -- | A printer extender. Takes as argument the user state that the@@ -71,6 +73,7 @@                   ,styleInitialState :: !s -- ^ User state, if needed.                   ,styleExtenders :: ![Extender s] -- ^ Extenders to the printer.                   ,styleDefConfig :: !Config -- ^ Default config to use for this style.+                  ,styleCommentPreprocessor :: forall s' m. MonadState (PrintState s') m => [Comment] -> m [Comment] -- ^ Preprocessor to use for comments.                   }  -- | Configurations shared among the different styles. Styles may pay

@@ -1,6 +1,5 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE QuasiQuotes #-}  -- | Main entry point to hindent.

@@ -78,7 +78,7 @@         (nonNull, _:rest) -> (map fst nonNull, map fst rest)      pieceBreak :: (String, String) -> Bool-    pieceBreak ("", "") = error "Two consecutive line breaks!"+    pieceBreak ("", "") = error $ "Two consecutive line breaks in:\n" ++ str     pieceBreak (line, next) = null line && head next /= ' '      mkNewlines :: String -> String

@@ -3,12 +3,10 @@        | D Float       -- ^ hi        | E Float Float -- ^ hi -data A = B             -- ^ hi-                       -- continuing the comment+data A = B             -- ^ hi continuing the comment        | C Int         -- ^ hi        | D Float       -- ^ hi-       | E Float Float -- ^ hi-                       -- continuing the comment+       | E Float Float -- ^ hi continuing the comment  a =   case x of@@ -42,11 +40,14 @@     Just something -> do       putStrLn "hello" -data X = X { a :: Int    -- ^ hi-           , b :: String -- ^ hi-           }+data X =+       X+         { a :: Int    -- ^ hi+         , b :: String -- ^ hi+         } -data X = X { a :: Int    -- ^ hi-           , b :: String -- ^ hi-                         -- continued-           }+data X =+       X+         { a :: Int    -- ^ hi+         , b :: String -- ^ hi continued+         }

@@ -2,8 +2,7 @@   where     blah = blah -    -- hello-    -- bye+    -- hello bye     hello = hello  a = b

@@ -2,14 +2,16 @@  a = b { c = "d", e = "f" } -longLines = longLines { longLines = "word word word word"-                      , wordWordWordWord = "long lines long long long"-                      }+longLines = longLines+  { longLines = "word word word word"+  , wordWordWordWord = "long lines long long long"+  }  a = B { c = "d" }  a = B { c = "d", e = "f" } -longLines = LongLines { longLines = "word word word word"-                      , wordWordWordWord = "long lines long long long"-                      }+longLines = LongLines+  { longLines = "word word word word"+  , wordWordWordWord = "long lines long long long"+  }

@@ -1,3 +1,2 @@--- Comment 1--- Comment 2+-- Comment 1 Comment 2 f x = x

@@ -1,4 +1,5 @@-a = A { reallyLongName = reallyLongName-      , reallyLongName = reallyLongName-      , aaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaa-      }+a = A+  { reallyLongName = reallyLongName+  , reallyLongName = reallyLongName+  , aaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaa+  }

@@ -0,0 +1,22 @@+-- Hello+a = a++-- Hello Hello+a = a++-- Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello+-- Hello Hello Hello Hello Hello+a = a++{-+Hello+-}+a = a++type Maybe a = forall r. (a -> r) -> r -> r -- foo bar zot sdfs zot sdfs zot sdfs zot sdfs zot sdfs+                                            -- zot sdfs zot sdfs zot sdfs zot sdfs++type Maybe a = forall r. (a -> r)+                      -> r+                      -> r -- foo bar zot sdfs zot sdfs zot sdfs zot sdfs zot sdfs zot sdfs zot sdfs+                           -- zot sdfs zot sdfs

@@ -0,0 +1,58 @@+instance A B+>+-- Hello+x = y++f x+  | pattern <- matched,+    condition+  = result++f x+  | pattern <- matched,+    condition+  = result++f x+  | pattern <- matched,+    condition+  = result++f x+  | pattern <- matched,+    pattern2 <- match2,+    pattern3 <- match3,+    condition+  = result++a =+  case x of+    LongLongRecordConstructor+      { longLongLongRecordName = val+      , longLongLongRecordName = val+      , longLongLongRecordName = val+      , longLongLongRecordName = val+      , longLongLongRecordName = val+      } -> val++-- This is a test+-- > Should not get rearranged+a = b++-- This is a test+-- > Should not get rearranged+-- > Should not get rearranged+a = b++-- This is a test+-- >>> Should not get rearranged+-- >>> Should not get rearranged+a = b++-- This is a test+-- @+--  f x = 3+--  f x = 3+-- @+--+a = b

@@ -0,0 +1,39 @@+instance A B where+  x = y+>+a = b++instance A B where+  x = y+>+a = b++data ConvertSpec f =+       ConvertSpec+         { convertToIpynb :: f Bool+         , convertInput :: f FilePath+         , convertOutput :: f FilePath+         , convertLhsStyle :: f (LhsStyle T.Text)+         , convertOverwriteFiles :: Bool+         }++f b+  | b = 3++f b+  | b =+      3++a =+  case x of+    Record { x = x }+      | test -> ans++a =+  case x of+    Just x+      | test -> ans++{-# NOINLINE val #-}++{-# INLINE val #-}

@@ -0,0 +1,46 @@+f x+  | a = b+  | a = b+  | a = b++f x+  | a = b+>+  | a = b+>+  | a = b++f x+  | a = b+>+  | a = b+>+>+  | a = b++f x+  -- branch+  | a = b+>+  -- branch+  | a = b+>+>+  -- branch+  | a = b++a = do+  let x = y+      z = 10+  3++a = do+  let x = y+>+>+      z = 10+  3++f x = 3+-- test+f x = 3

@@ -0,0 +1,17 @@+   x = 3++#if+    x = 3+#else+    y = 3+#endif++f = z + moreThings+  where+    x = 3+#if MIN_VERSION_ghc(7, 10, 0)+    z = 10+#else+    z = 11+#endif+    moreThings = z + 1

@@ -0,0 +1,3 @@+  > x = 3+  > +  > x = 3

@@ -0,0 +1,60 @@+import           A.Long.Module.Name (With(many, many, many, many, many), imports, and, exports, that,+                                     don't, fit, on, one, line, at, all)++import           A.Long.Module.Name (With(many, many, many, many, many),+                                     With(many, many, many, many, many),+                                     With(many, many, many, many, many), imports, and, exports, that,+                                     don't, fit, on, one, line, at, all)++f (Zee x) =+  -- Comment!+  startswith "No instance for (Show" msg && True++x = do+  -- hi+  return+    output+      { longLongLong = 3+      , longLongLong = 3+      , longLongLong = 3+      , longLongLong = 3+      , longLongLong = 3+      , longLongLong = 3+      }++f x = f $ do+  -- hello+  f x++f x = f $+  -- hello+  f x++a =+  case x of+    z -> y -- what+    z -> y++class A be where+  x = y+  z = w++class A b where+  x = y+>+  z = w++data Widget = forall a. IHaskellWidget a => Widget a+  deriving Typeable++instance Monoid X where+  mempty = X+  X `mappend` X = X++a =+  let x = X+            { y = z+            -- FIXME+            , z = z+            }+  in Z

@@ -0,0 +1,5 @@+instance A B where+  x =+    3+>+x = y

@@ -0,0 +1,8 @@+type X = Y+>+-- Comment+instance A a => B a where+  x = y++{-# INLINE x #-}+x = 3

@@ -0,0 +1,19 @@+a =+  if | x -> y+     | z -> z++a =+  if | x+      , x <- Just y -> y++a =+  f $ \x ->+    -- hello+    z++a =+  f $ \x -> do+    -- hello+    z++{-# OPTIONS_GHC -option #-}

@@ -1,43 +1,30 @@ data A = B { field :: Int } -data A = B { field :: Int-           , field2 :: Char-           }+data A = B { field :: Int, field2 :: Char } -data A = B { field :: Int-           , field2 :: Char-           , field3 :: String-           }+data A = B { field :: Int, field2 :: Char, field3 :: String } -data A = B { field :: Int-           , field2 :: Char-           , field3 :: String-           }+data A = B { field :: Int, field2 :: Char, field3 :: String }   deriving Show -data A = B { field :: Int-           , field2 :: Char-           , field3 :: String-           }+data A = B { field :: Int, field2 :: Char, field3 :: String }   deriving Show -data A = B { field :: Int-           , field2 :: Char-           , field3 :: String-           }+data A = B { field :: Int, field2 :: Char, field3 :: String }   deriving (Show, Eq) -data A = B { field :: Int-           , field2 :: Char-           , field3 :: String-           }+data A = B { field :: Int, field2 :: Char, field3 :: String }   deriving (Show, Eq) -data A = B { field :: Int -- ^ Field 1-           }+data A =+       B+         { field :: Int -- ^ Field 1+         } -data A = B { field :: Int  -- ^ Field 1-           , field2 :: Char   -- ^ field 2-           , field3 :: String-           }+data A =+       B+         { field :: Int  -- ^ Field 1+         , field2 :: Char   -- ^ field 2+         , field3 :: String+         }   deriving Show

@@ -3,12 +3,10 @@        | D Float       -- ^ hi        | E Float Float -- ^ hi -data A = B             -- ^ hi-                       -- continuing the comment+data A = B             -- ^ hi continuing the comment        | C Int         -- ^ hi        | D Float       -- ^ hi-       | E Float Float -- ^ hi-                       -- continuing the comment+       | E Float Float -- ^ hi continuing the comment  a = case x of   Nothing -> 2@@ -41,6 +39,5 @@            }  data X = X { a :: Int    -- ^ hi-           , b :: String -- ^ hi-                         -- continued+           , b :: String -- ^ hi continued            }

@@ -2,8 +2,7 @@   where     blah = blah -    -- hello-    -- bye+    -- hello bye     hello = hello  a = b

@@ -1,3 +1,2 @@--- Comment 1--- Comment 2+-- Comment 1 Comment 2 f x = x

@@ -1,4 +1,5 @@-a = A { reallyLongName = reallyLongName-      , reallyLongName = reallyLongName-      , aaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaa-      }+a = A+  { reallyLongName = reallyLongName+  , reallyLongName = reallyLongName+  , aaaaaaaaaaaaaaaaaaaaa = aaaaaaaaaaaaaaaa+  }

@@ -0,0 +1,25 @@+-- Hello+a = a++-- Hello+-- Hello+a = a++-- Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello Hello+a = a++{-+Hello+-}+a = a++type Maybe a = forall r. (a -> r) -> r -> r -- foo bar zot sdfs zot+                                            -- sdfs zot sdfs zot sdfs+                                            -- zot sdfs zot sdfs zot+                                            -- sdfs zot sdfs zot sdfs++type Maybe a = +  forall r. (a -> r) +            -> r +            -> r -- foo bar zot sdfs zot sdfs zot sdfs zot sdfs zot+                 -- sdfs zot sdfs zot sdfs zot sdfs zot sdfs

@@ -0,0 +1,48 @@+instance A B+>+-- Hello+x = y++f x+  | pattern <- matched,+    condition+  = result++f x+  | pattern <- matched, condition+  = result++f x+  | pattern <- matched, condition = result++f x+  | pattern <- matched,+    pattern2 <- match2,+    pattern3 <- match3,+    condition+  = result++a = case x of+  LongLongRecordConstructor { longLongLongRecordName = val, longLongLongRecordName = val, longLongLongRecordName = val, longLongLongRecordName = val, longLongLongRecordName = val }  -> val++-- This is a test+-- > Should not get rearranged+a = b++-- This is a test+-- > Should not get rearranged+-- > Should not get rearranged+a = b++-- This is a test+-- >>> Should not get rearranged+-- >>> Should not get rearranged+a = b++-- This is a test+-- @+--  f x = 3+--  f x = 3+-- @+--+a = b

@@ -0,0 +1,37 @@+instance A B where+  x = y+>+a = b++instance A B where+  x = y+>+a = b++data ConvertSpec f =+       ConvertSpec+         { convertToIpynb :: f Bool+         , convertInput :: f FilePath+         , convertOutput :: f FilePath+         , convertLhsStyle :: f (LhsStyle T.Text)+         , convertOverwriteFiles :: Bool+         }++f b+  | b = 3++f b+  | b =+      3++a =+  case x of+    Record { x = x }| test -> ans++a =+  case x of+    Just x | test -> ans++{-# NOINLINE val #-}++{-# INLINE val #-}

@@ -0,0 +1,46 @@+f x+  | a = b+  | a = b+  | a = b++f x+  | a = b+>+  | a = b+>+  | a = b++f x+  | a = b+>+  | a = b+>+>+  | a = b++f x+  -- branch+  | a = b+>+  -- branch+  | a = b+>+>+  -- branch+  | a = b++a = do+  let x = y+      z = 10+  3++a = do+  let x = y+>+>+      z = 10+  3++f x = 3+-- test+f x = 3

@@ -0,0 +1,17 @@+   x = 3++#if+    x = 3+#else+    y = 3+#endif++f = z + moreThings+  where+    x = 3+#if MIN_VERSION_ghc(7, 10, 0)+    z = 10+#else+    z = 11+#endif+    moreThings = z + 1

@@ -0,0 +1,2 @@+  > x = 3+  > x = 3

@@ -0,0 +1,46 @@+import A.Long.Module.Name (With(many, many, many,  many, many), imports, and, exports, that, don't, fit, on, one, line, at, all)++import A.Long.Module.Name (With(many, many, many,  many, many), With(many, many, many,  many, many), With(many, many, many,  many, many), imports, and, exports, that, don't, fit, on, one, line, at, all)++f (Zee x) =+  -- Comment!+  startswith "No instance for (Show" msg && True++x = do+  -- hi+  return output { longLongLong = 3,  longLongLong = 3, longLongLong = 3, longLongLong = 3, longLongLong = 3, longLongLong = 3}++f x = f $ do+  -- hello+  f x++f x = f $+  -- hello+  f x++a =+  case x of+    z -> y -- what+    z -> y++class A be where+  x = y+  z = w++class A b where+  x = y+>+  z = w++data Widget = forall a. IHaskellWidget a => Widget a+  deriving Typeable++instance Monoid X where+    mempty = X+    X `mappend` X = X++a =+  let x = X { y = z, +              -- FIXME+              z = z }+  in Z

@@ -0,0 +1,5 @@+instance A B where+  x =+    3+>+x = y

@@ -0,0 +1,9 @@+type X = Y+>+-- Comment+instance A a => B a where+  x = y+>++{-# INLINE x #-}+x = 3

@@ -0,0 +1,19 @@+a = +  if | x -> y+     | z -> z++a =+  if | x, x <- Just y -> y++a =+  f $ \x ->+    -- hello+    z++a =+  f $ \x -> do+    -- hello+    z++{-# OPTIONS_GHC -option #-}+>

@@ -0,0 +1,7 @@+fun :: (Class a, Class b)+    => a -> b -> c++fun :: (a, b, c) -> (a, b)++fun :: (Class a, Class b)+    => a -> (# d, e #) -> c

@@ -0,0 +1,7 @@+fun :: (Class a,Class b)+    => a -> b -> c++fun :: (a,b,c) -> (a,b)++fun :: (Class a, Class b)+    => a ->(# d,e #)-> c