haskell-formatter 0.1.0 → 1.0.0

raw patch · 24 files changed

+399/−230 lines, 24 filesdep ~basedep ~containersdep ~directoryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, directory, directory-tree, doctest, filemanip, filepath, haskell-src-exts, hlint, optparse-applicative, scientific, tasty, tasty-hunit, text, unordered-containers, yaml

API changes (from Hackage documentation)

Files

• .gitignore +2/−0
• Makefile +23/−8
• README.rst +30/−12
• haskell-formatter.cabal +23/−23
• src/library/Language/Haskell/Formatter.hs +5/−6
• src/library/Language/Haskell/Formatter/CommentCore.hs +2/−2
• src/library/Language/Haskell/Formatter/Configuration.hs +3/−1
• src/library/Language/Haskell/Formatter/ExactCode.hs +3/−0
• src/library/Language/Haskell/Formatter/Internal/StyleFileFormat.hs +3/−0
• src/library/Language/Haskell/Formatter/Location.hs +7/−7
• src/library/Language/Haskell/Formatter/Process/AttachComments.hs +77/−44
• src/library/Language/Haskell/Formatter/Process/Code.hs +15/−11
• src/library/Language/Haskell/Formatter/Process/CodeOrdering.hs +6/−5
• src/library/Language/Haskell/Formatter/Process/DetachComments.hs +7/−7
• src/library/Language/Haskell/Formatter/Process/FormatActualCode.hs +20/−20
• src/library/Language/Haskell/Formatter/Process/FormatComments.hs +70/−8
• src/library/Language/Haskell/Formatter/Process/LineShifting.hs +0/−37
• src/library/Language/Haskell/Formatter/Process/LineTool.hs +41/−0
• src/library/Language/Haskell/Formatter/Style.hs +16/−3
• src/library/Language/Haskell/Formatter/Toolkit/ListTool.hs +30/−23
• src/library/Language/Haskell/Formatter/Toolkit/Splitter.hs +4/−4
• src/library/Language/Haskell/Formatter/Toolkit/Visit.hs +3/−3
• testsuite/resources/examples/default_style.yaml +8/−5
• testsuite/src/Language/Haskell/Formatter/Toolkit/FileTesting.hs +1/−1

@@ -1,2 +1,4 @@+.cabal-sandbox/+cabal.sandbox.config dist README.xhtml

@@ -1,22 +1,37 @@ FORMATTED_FILES = Setup.hs src testsuite/src-FORMATTER_UTILITY = dist/build/haskell-formatter/haskell-formatter+FORMATTER_UTILITY = cabal run -- FORMATTER_ARGUMENTS = --force --input {} --output {}-GENERATED_FILES = dist README.xhtml -all:+.PHONY : all build test document format sandbox clean++all : build test document format++build :+	cabal install --only-dependencies --enable-tests -j 	cabal configure --enable-tests-	cabal build+	cabal build -j -	cabal test+test : build+	cabal test -j+	cabal check +document : build README.xhtml 	cabal haddock --internal-	rst2html --strict README.rst README.xhtml +%.xhtml : %.rst+	rst2html --strict $< $@++format : build #	Use "xargs" instead of "-exec", since #	1. the call should fail if any "-exec" fails and #	2. the behavior of multiple "{}" is undefined for a standard "find". 	find $(FORMATTED_FILES) -type f -name '*.hs' -print0 | \ 		xargs -n 1 -0 -I {} $(FORMATTER_UTILITY) $(FORMATTER_ARGUMENTS) -clean:-	rm -fr $(GENERATED_FILES)+sandbox :+	cabal sandbox init+	$(MAKE) build++clean :+	cabal clean+	cabal sandbox delete

@@ -2,32 +2,47 @@ Haskell Formatter ================= -Introduction-============- The Haskell Formatter formats Haskell source code. It is strict in that it fundamentally rearranges code.  Installation ============ +Run+ ::      $ cabal install haskell-formatter +to create an executable, which is referred to as ``haskell-formatter`` in the following. On Linux, for example, you should now be able to call it as++::++    $ ~/.cabal/bin/haskell-formatter --help++In case of issues with dependencies, try to use a Cabal sandbox. For convenience, this can be done by++::++    $ make sandbox+ Usage =====  Basics ------ -For example, source code is read from ``Input.hs``, formatted, and written to ``Output.hs`` by+Read source code from ``Input.hs``, format it, and write it to ``Output.hs`` by  ::      $ haskell-formatter --input Input.hs --output Output.hs -If the input or output file is not given, it defaults to the corresponding standard stream.+If the input or output file is not given, it defaults to the corresponding standard stream. This allows commands like +::++    $ haskell-formatter < Input.hs+ For more help about the usage, call  ::@@ -43,7 +58,7 @@      $ haskell-formatter --style my_style.yaml --input Input.hs --output Output.hs -uses ``my_style.yaml`` as a style file. Such a file generally follows the `YAML format <http://en.wikipedia.org/wiki/YAML>`_. The following is an `example style file <testsuite/resources/examples/default_style.yaml>`_, which at the same time shows the available keys with their default values.+uses ``my_style.yaml`` as a style file. Such files are in the `YAML format <http://en.wikipedia.org/wiki/YAML>`_. The following is an `example style file <testsuite/resources/examples/default_style.yaml>`_, which at the same time shows the available keys with their default values.  .. GitHub does currently not allow to include files with the reStructuredText directive ``include`` (https://github.com/github/markup/issues/172). @@ -62,13 +77,16 @@     # Reference: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.38.8777     ribbons_per_line: 1     +    # More than this number of empty lines in succession are merged.+    successive_empty_lines_limit: 1+         # Indentation lengths in characters.     indentations:-        class: 8     # "class" and "instance" declarations.-        do: 3        # "do" notation. -        case: 4      # Body of "case" expressions.-        let: 4       # Declarations in "let" expressions.-        where: 6     # Declarations in "where" clauses.+        class:  8    # "class" and "instance" declarations.+        do:     3    # "do" notation. +        case:   4    # Body of "case" expressions.+        let:    4    # Declarations in "let" expressions.+        where:  6    # Declarations in "where" clauses.         onside: 2    # Continuation lines which would otherwise be offside.          # Decides which parts of the code to sort.@@ -82,7 +100,7 @@ Related Projects ================ -The following interesting projects aim at formatting Haskell code, too.+You may like to have a look at the following projects, which aim at formatting Haskell code, too.  * `hindent <https://github.com/chrisdone/hindent>`_ * `stylish-haskell <https://github.com/jaspervdj/stylish-haskell>`_

@@ -1,5 +1,5 @@ name:                  haskell-formatter-version:               0.1.0+version:               1.0.0 synopsis:              Haskell source code formatter homepage:              https://github.com/evolutics/haskell-formatter bug-reports:           https://github.com/evolutics/haskell-formatter/issues@@ -7,7 +7,7 @@ license-file:          LICENSE author:                Benjamin Fischer maintainer:            Benjamin Fischer <benjamin.fischer@evolutics.info>-copyright:             (C) 2014 Benjamin Fischer+copyright:             (C) 2014–2015 Benjamin Fischer category:              Development build-type:            Simple cabal-version:         >= 1.8@@ -49,7 +49,7 @@     Language.Haskell.Formatter.Process.FormatActualCode,     Language.Haskell.Formatter.Process.FormatComments,     Language.Haskell.Formatter.Process.Formatter,-    Language.Haskell.Formatter.Process.LineShifting,+    Language.Haskell.Formatter.Process.LineTool,     Language.Haskell.Formatter.Process.Note,     Language.Haskell.Formatter.Result,     Language.Haskell.Formatter.Source,@@ -60,13 +60,13 @@     Language.Haskell.Formatter.Toolkit.Visit    build-depends:-    base == 4.6.*,-    containers == 0.5.*,-    haskell-src-exts == 1.15.*,-    scientific == 0.3.*,-    text == 1.1.*,-    unordered-containers == 0.2.*,-    yaml == 0.8.*+    base >= 4.6 && < 4.8,+    containers >= 0.5,+    haskell-src-exts == 1.16.*,+    scientific >= 0.3,+    text >= 1.0,+    unordered-containers >= 0.2,+    yaml >= 0.8    hs-source-dirs:     src/library@@ -77,11 +77,11 @@   main-is:             Main.hs    build-depends:-    base == 4.6.*,-    directory == 1.2.*,-    filepath == 1.3.*,+    base >= 4.6 && < 4.8,+    directory >= 1.2,+    filepath >= 1.3,     haskell-formatter,-    optparse-applicative == 0.10.*+    optparse-applicative >= 0.10    hs-source-dirs:     src/executable@@ -100,16 +100,16 @@     Language.Haskell.Formatter.Toolkit.TestTool    build-depends:-    base == 4.6.*,-    containers == 0.5.*,-    directory-tree == 0.12.*,-    doctest == 0.9.*,-    filemanip == 0.3.*,-    filepath == 1.3.*,+    base >= 4.6 && < 4.8,+    containers >= 0.5,+    directory-tree >= 0.11,+    doctest >= 0.9,+    filemanip >= 0.3,+    filepath >= 1.3,     haskell-formatter,-    hlint == 1.9.*,-    tasty == 0.9.*,-    tasty-hunit == 0.9.*+    hlint >= 1.9,+    tasty >= 0.9,+    tasty-hunit >= 0.8    hs-source-dirs:     testsuite/src

@@ -2,13 +2,12 @@ Description : Haskell source code formatter -} module Language.Haskell.Formatter-       (Configuration.Configuration(..), Configuration.defaultConfiguration,-        Error.Error, Error.isAssertionError, Main.defaultFormat, Main.format,-        StreamName.createStreamName, StreamName.standardInput,-        StreamName.StreamName, Style.Indentation, Style.Style(..))+       (module Configuration, Error.Error, Error.isAssertionError,+        Main.defaultFormat, Main.format, StreamName.createStreamName,+        StreamName.standardInput, StreamName.StreamName, module Style)        where-import qualified Language.Haskell.Formatter.Configuration as Configuration+import Language.Haskell.Formatter.Configuration as Configuration hiding (check) import qualified Language.Haskell.Formatter.Error as Error import qualified Language.Haskell.Formatter.Main as Main-import qualified Language.Haskell.Formatter.Style as Style+import Language.Haskell.Formatter.Style as Style hiding (check) import qualified Language.Haskell.Formatter.Toolkit.StreamName as StreamName

@@ -8,6 +8,7 @@ import qualified Data.Char as Char import qualified Data.Monoid as Monoid import qualified Language.Haskell.Formatter.Internal.Newline as Newline+import qualified Language.Haskell.Formatter.Toolkit.ListTool as ListTool  data CommentCore = CommentCore{kind :: Kind, content :: String}                  deriving (Eq, Ord)@@ -41,6 +42,5 @@         ('^' : _) -> AfterActualCode         _ -> None   where unwrappedContent-          = Monoid.mappend (dropWhile Char.isSpace deformable) rigid-        (deformable, rigid) = splitAt spaceLimit $ content comment+          = ListTool.dropWhileAtMost Char.isSpace spaceLimit $ content comment         spaceLimit = 1

@@ -2,7 +2,9 @@ Description : Overall configuration -} module Language.Haskell.Formatter.Configuration-       (Configuration(..), defaultConfiguration, check) where+       (Configuration, configurationStyle, configurationStreamName,+        defaultConfiguration, check)+       where import qualified Language.Haskell.Formatter.Result as Result import qualified Language.Haskell.Formatter.Source as Source import qualified Language.Haskell.Formatter.Style as Style

@@ -14,6 +14,9 @@           where rawActualCode = actualCode exact                 rawComments = comments exact +instance Location.Portioned ExactCode where+        getPortion = Location.getPortion . actualCode+ create :: Source.Module Location.SrcSpanInfo -> [Source.Comment] -> ExactCode create rawActualCode rawComments   = ExactCode{actualCode = rawActualCode, comments = rawComments}

@@ -16,6 +16,9 @@        ("ribbons_per_line",         MapTree.Leaf . TreeFormat.SingleFloating $           \ value style -> style{Formatter.ribbonsPerLine = value}),+       ("successive_empty_lines_limit",+        MapTree.Leaf . TreeFormat.LimitedInteger $+          \ value style -> style{Formatter.successiveEmptyLinesLimit = value}),        ("indentations",         MapTree.Node $           Map.fromList

@@ -19,15 +19,15 @@ import qualified Language.Haskell.Formatter.Toolkit.StreamName as StreamName import Prelude hiding (getLine) -class (Enum a) => Natural a where+class Enum a => Natural a where          base :: a -        plus :: (Integral b) => b -> a -> a+        plus :: Integral b => b -> a -> a         plus difference natural           = toEnum $ fromIntegral difference + fromEnum natural -        minus :: (Num b) => a -> a -> b+        minus :: Num b => a -> a -> b         minus minuend = fromIntegral . Function.on (-) fromEnum minuend  class Portioned a where@@ -57,13 +57,13 @@ instance Portioned SrcLoc.SrcSpanInfo where         getPortion = SrcLoc.srcInfoSpan -instance (Portioned a) => Portioned (Syntax.Module a) where+instance Portioned a => Portioned (Syntax.Module a) where         getPortion = getPortion . Syntax.ann  instance Portioned Comments.Comment where         getPortion (Comments.Comment _ commentPortion _) = commentPortion -streamName :: (SrcLoc.SrcInfo a) => a -> StreamName.StreamName+streamName :: SrcLoc.SrcInfo a => a -> StreamName.StreamName streamName = StreamName.createStreamName . SrcLoc.fileName  getLine :: SrcLoc.SrcLoc -> Line@@ -116,10 +116,10 @@         hasSingleLine = lineCount == 1         startColumn = getStartColumn startPosition -getStartLine :: (SrcLoc.SrcInfo a) => a -> Line+getStartLine :: SrcLoc.SrcInfo a => a -> Line getStartLine = getLine . SrcLoc.getPointLoc -getStartColumn :: (SrcLoc.SrcInfo a) => a -> Column+getStartColumn :: SrcLoc.SrcInfo a => a -> Column getStartColumn = getColumn . SrcLoc.getPointLoc  getEndLine :: SrcLoc.SrcSpan -> Line

@@ -14,6 +14,7 @@ import qualified Language.Haskell.Formatter.ExactCode as ExactCode import qualified Language.Haskell.Formatter.Location as Location import qualified Language.Haskell.Formatter.Process.Code as Code+import qualified Language.Haskell.Formatter.Process.LineTool as LineTool import qualified Language.Haskell.Formatter.Process.Note as Note import qualified Language.Haskell.Formatter.Result as Result import qualified Language.Haskell.Formatter.Source as Source@@ -22,6 +23,11 @@ data Assignment = Assignment (Map.Map Location.SrcSpan Note.CommentNote)                 deriving (Eq, Ord, Show) +data CodeGap = InfiniteLower Location.SrcSpan+             | FiniteGap Location.SrcSpan Location.SrcSpan+             | InfiniteUpper Location.SrcSpan+             deriving (Eq, Ord, Show)+ instance Monoid.Monoid Assignment where         mempty = Assignment Map.empty         mappend (Assignment left) (Assignment right) = Assignment merged@@ -31,47 +37,60 @@                Style.Style ->                  ExactCode.ExactCode -> Result.Result Code.CommentableCode attachComments _ exact-  = if Map.null unassigned then return commentable else-      Result.fatalAssertionError message-  where (Assignment unassigned, commentable) = spread assignment locatable-        assignment = assignForCode exact-        locatable = ExactCode.actualCode exact+  = do assignment <- assignForCode exact+       let (Assignment unassigned, commentable) = spread assignment locatable+       if Map.null unassigned then return commentable else+         Result.fatalAssertionError message+  where locatable = ExactCode.actualCode exact         message = "Attaching the comments failed with an unassigned rest." -spread :: Assignment -> Code.LocatableCode -> (Assignment, Code.CommentableCode)-spread (Assignment assignment) locatable = (Assignment unassigned, commentable)-  where (unassigned, commentable)-          = Traversable.mapAccumL move assignment locatable-        move rest nestedPortion = (rest', note)-          where (maybeNote, rest') = Map.updateLookupWithKey remove portion rest-                remove = const . const Nothing-                portion = Location.getPortion nestedPortion-                note = Foldable.fold maybeNote--assignForCode :: ExactCode.ExactCode -> Assignment+assignForCode :: ExactCode.ExactCode -> Result.Result Assignment assignForCode exact-  = Monoid.mappend (Monoid.mconcat untilLast) assignedAfterLast-  where ((maybeLast, afterLast), untilLast)-          = Traversable.mapAccumL move base orderedPortions-        move (maybeLower, rest) upper = ((Just upper, rest'), assignment)-          where (comments, rest') = span ((<= upper) . Location.getPortion) rest-                assignment = assignComments maybeLower upper boxes-                boxes = createComments comments+  = case unassigned of+        [] -> return $ Monoid.mconcat assignments+        (_ : _) -> Result.fatalAssertionError message+  where ((_, unassigned), assignments)+          = Traversable.mapAccumL move base maybeOrderedPortions+        move (maybeLower, rest) maybeUpper = ((maybeUpper, rest'), assignment)+          where (rest', assignment)+                  = case maybeUpper of+                        Nothing -> case maybeLower of+                                       Nothing -> (rest, Monoid.mempty)+                                       Just lower -> ([],+                                                      assign+                                                        (InfiniteUpper lower)+                                                        rest)+                        Just upper -> (greaterUpper, assign gap lessEqualUpper)+                          where (lessEqualUpper, greaterUpper)+                                  = span ((<= upper) . Location.getPortion) rest+                                gap+                                  = case maybeLower of+                                        Nothing -> InfiniteLower upper+                                        Just lower -> FiniteGap lower upper+        assign gap = assignComments gap . createComments startLine endLine+          where (startLine, endLine)+                  = case gap of+                        InfiniteLower upper -> (pred Location.base,+                                                Location.getStartLine upper)+                        FiniteGap lower upper -> (Location.getEndLine lower,+                                                  Location.getStartLine upper)+                        InfiniteUpper lower -> (Location.getEndLine lower,+                                                codeEndLine)+        codeEndLine = Location.getEndLine $ Location.getPortion exact         base = (Nothing, orderedComments)         (orderedPortions, orderedComments) = orderByStartEnd exact-        assignedAfterLast = Foldable.foldMap assignLast maybeLast-        assignLast = flip assignAfter lastBoxes-        lastBoxes = createComments afterLast+        maybeOrderedPortions+          = Monoid.mappend (fmap Just orderedPortions) [Nothing]+        message = "Assigning the comments failed with an unexpected rest." -assignComments ::-               Maybe Location.SrcSpan ->-                 Location.SrcSpan -> [Note.CommentBox] -> Assignment-assignComments Nothing upper comments = assignBefore upper comments-assignComments (Just lower) upper comments+assignComments :: CodeGap -> [Note.CommentBox] -> Assignment+assignComments (InfiniteLower upper) comments = assignBefore upper comments+assignComments (FiniteGap lower upper) comments   = Monoid.mappend assignedAfter assignedBefore   where assignedAfter = assignAfter lower after-        (after, _, before) = divideComments comments-        assignedBefore = assignBefore upper before+        (after, spaces, before) = divideComments comments+        assignedBefore = assignBefore upper $ Monoid.mappend spaces before+assignComments (InfiniteUpper lower) comments = assignAfter lower comments  assignBefore :: Location.SrcSpan -> [Note.CommentBox] -> Assignment assignBefore portion = flip (assignSingleton portion) []@@ -104,24 +123,28 @@         divide after spaces (Note.EmptyLine : unwrapped)           = divide after (Monoid.mappend spaces [Note.EmptyLine]) unwrapped -createComments :: [Source.Comment] -> [Note.CommentBox]-createComments = concat . snd . Traversable.mapAccumL create Nothing-  where create maybeEndLine comment = (Just endLine', comments)+createComments ::+               Location.Line ->+                 Location.Line -> [Source.Comment] -> [Note.CommentBox]+createComments gapStartLine gapEndLine comments+  = Monoid.mappend (concat untilLast) lastBoxes+  where (lastEndLine, untilLast)+          = Traversable.mapAccumL create gapStartLine comments+        create endLine comment = (endLine', boxes)           where endLine' = Location.getEndLine portion                 portion = Location.getPortion comment-                comments = Monoid.mappend emptyLines actualComments-                emptyLines-                  = case maybeEndLine of-                        Nothing -> []-                        Just endLine -> replicate emptyLineCount Note.EmptyLine-                          where emptyLineCount = pred lineDistance-                                lineDistance-                                  = Location.minus startLine endLine :: Int+                boxes = Monoid.mappend emptyLines actualComments+                emptyLines = createEmptyLines endLine startLine                 startLine = Location.getStartLine portion                 actualComments = [Note.ActualComment indentedComment]                 indentedComment = Note.createIndentedComment core Location.base                 core = Source.commentCore comment+        lastBoxes = createEmptyLines lastEndLine gapEndLine +createEmptyLines :: Location.Line -> Location.Line -> [Note.CommentBox]+createEmptyLines endLine startLine = replicate emptyLineCount Note.EmptyLine+  where emptyLineCount = LineTool.countEmptyLines endLine startLine+ orderByStartEnd :: ExactCode.ExactCode -> ([Location.SrcSpan], [Source.Comment]) orderByStartEnd exact = (orderedPortions, orderedComments)   where orderedPortions = fmap Location.getPortion nestedPortions@@ -130,3 +153,13 @@         orderedComments           = List.sortBy (Function.on compare Location.getPortion) comments         comments = ExactCode.comments exact++spread :: Assignment -> Code.LocatableCode -> (Assignment, Code.CommentableCode)+spread (Assignment assignment) locatable = (Assignment unassigned, commentable)+  where (unassigned, commentable)+          = Traversable.mapAccumL move assignment locatable+        move rest nestedPortion = (rest', note)+          where (maybeNote, rest') = Map.updateLookupWithKey remove portion rest+                remove = const . const Nothing+                portion = Location.getPortion nestedPortion+                note = Foldable.fold maybeNote

@@ -2,7 +2,7 @@ Description : Syntax tree types -} module Language.Haskell.Formatter.Process.Code-       (LocatableCode, CommentableCode, LocatableCommentableCode,+       (LocatableCode, CommentableCode, LocatableCommentableCode, tryZipCode,         tryZipLocationsComments, dropComments, dropLocations)        where import qualified Language.Haskell.Formatter.Location as Location@@ -17,21 +17,25 @@  type LocatableCommentableCode = Source.Module Note.LocationCommentNote -tryZipLocationsComments ::-                        LocatableCode ->-                          CommentableCode ->-                            Result.Result LocatableCommentableCode-tryZipLocationsComments locatable commentable+tryZipCode ::+           (a -> b -> c) ->+             Source.Module a ->+               Source.Module b -> Result.Result (Source.Module c)+tryZipCode merge left right   = case maybeZipped of         Nothing -> Result.fatalAssertionError message           where message = "The code notes could not be zipped."         Just zipped -> return zipped   where maybeZipped-          = if isActualCodeSame then maybeLocatableCommentable else Nothing-        isActualCodeSame = locatable Source.=~= commentable-        maybeLocatableCommentable-          = Visit.halfZipWith Note.createLocationCommentNote locatable-              commentable+          = if isActualCodeSame then Visit.halfZipWith merge left right else+              Nothing+        isActualCodeSame = left Source.=~= right++tryZipLocationsComments ::+                        LocatableCode ->+                          CommentableCode ->+                            Result.Result LocatableCommentableCode+tryZipLocationsComments = tryZipCode Note.createLocationCommentNote  dropComments :: LocatableCommentableCode -> LocatableCode dropComments = fmap Note.locationNote

@@ -15,10 +15,11 @@                           Code.LocatableCommentableCode orderImportDeclarations = replaceImportDeclarations $ Visit.orderByKey key   where key-          (Syntax.ImportDecl _ moduleName isQualified isWithSource package alias-             entitiesList)-          = (moduleNameKey moduleName, isQualified, isWithSource, package,-             fmap moduleNameKey alias, fmap entitiesListKey entitiesList)+          (Syntax.ImportDecl _ moduleName isQualified isWithSource isSafe+             package alias entitiesList)+          = (moduleNameKey moduleName, isQualified, isWithSource, isSafe,+             package, fmap moduleNameKey alias,+             fmap entitiesListKey entitiesList)         moduleNameKey (Syntax.ModuleName _ name) = name         entitiesListKey (Syntax.ImportSpecList _ isHiding entities)           = (isHiding, fmap importEntityKey entities)@@ -36,7 +37,7 @@   where importDeclarations' = function importDeclarations  importEntityKey :: Syntax.ImportSpec a -> [String]-importEntityKey (Syntax.IVar _ name) = rootNameKey name+importEntityKey (Syntax.IVar _ _ name) = rootNameKey name importEntityKey (Syntax.IAbs _ name) = rootNameKey name importEntityKey (Syntax.IThingAll _ name) = rootNameKey name importEntityKey (Syntax.IThingWith _ name entities)

@@ -13,7 +13,7 @@ import qualified Language.Haskell.Formatter.ExactCode as ExactCode import qualified Language.Haskell.Formatter.Location as Location import qualified Language.Haskell.Formatter.Process.Code as Code-import qualified Language.Haskell.Formatter.Process.LineShifting as LineShifting+import qualified Language.Haskell.Formatter.Process.LineTool as LineTool import qualified Language.Haskell.Formatter.Process.Note as Note import qualified Language.Haskell.Formatter.Result as Result import qualified Language.Haskell.Formatter.Source as Source@@ -45,21 +45,21 @@                    Result.Result ExactCode.ExactCode detachComments _ locatableCommentable   = return $ ExactCode.create locatable' comments-  where locatable' = LineShifting.shiftCode shifter locatable+  where locatable' = LineTool.shiftCode shifter locatable         shifter = reservationShifter reservation         reservation = reserveForCode locatableCommentable         locatable = Code.dropComments locatableCommentable         comments = createComments stream reservation         stream = Location.streamName $ Location.getPortion locatable' -reservationShifter :: Reservation -> LineShifting.Shifter+reservationShifter :: Reservation -> LineTool.Shifter reservationShifter (Reservation reservation)-  = LineShifting.createShifter $ fmap commentsShift reservation+  = LineTool.createShifter $ fmap commentsShift reservation -commentsShift :: [Note.CommentBox] -> LineShifting.Shift+commentsShift :: [Note.CommentBox] -> LineTool.Shift commentsShift = sum . fmap commentShift -commentShift :: Note.CommentBox -> LineShifting.Shift+commentShift :: Note.CommentBox -> LineTool.Shift commentShift (Note.ActualComment comment)   = CommentCore.wrappedLineCount $ Note.commentCore comment commentShift Note.EmptyLine = 1@@ -92,7 +92,7 @@                         Note.EmptyLine -> []  accumulateReservation ::-                        (Monoid.Monoid m) =>+                        Monoid.Monoid m =>                         (Location.Line -> [Note.CommentBox] -> m) ->                           Reservation -> m accumulateReservation create (Reservation reservation) = accumulation

@@ -21,25 +21,6 @@   where locatableCommentable' = prepare style locatableCommentable         commentable = Code.dropLocations locatableCommentable' -prepare ::-        Style.Style ->-          Code.LocatableCommentableCode -> Code.LocatableCommentableCode-prepare style = Visit.compose preparations-  where preparations-          = [preparation | (isApplied, preparation) <- applications,-             isApplied style]-        applications-          = [(Style.orderImportDeclarations,-              CodeOrdering.orderImportDeclarations),-             (Style.orderImportEntities, orderImportEntities)]--orderImportEntities ::-                    Code.LocatableCommentableCode ->-                      Code.LocatableCommentableCode-orderImportEntities-  = CodeOrdering.orderRootImportEntities .-      CodeOrdering.orderNestedImportEntities- prettyPrint ::             Style.Style ->               Code.LocatableCommentableCode -> Result.Result Code.LocatableCode@@ -59,7 +40,7 @@                   where message = "Formatting the actual code failed to zip."                 Just locatable' -> return locatable' -defaultPrettyPrint :: (Source.Pretty a) => Style.Style -> a -> String+defaultPrettyPrint :: Source.Pretty a => Style.Style -> a -> String defaultPrettyPrint   = Applicative.liftA2 Source.prettyPrintStyleMode renderingStyle mode @@ -76,3 +57,22 @@                        Source.letIndent = Style.letIndentation style,                        Source.whereIndent = Style.whereIndentation style,                        Source.onsideIndent = Style.onsideIndentation style}++prepare ::+        Style.Style ->+          Code.LocatableCommentableCode -> Code.LocatableCommentableCode+prepare style = Visit.compose preparations+  where preparations+          = [preparation | (isApplied, preparation) <- applications,+             isApplied style]+        applications+          = [(Style.orderImportDeclarations,+              CodeOrdering.orderImportDeclarations),+             (Style.orderImportEntities, orderImportEntities)]++orderImportEntities ::+                    Code.LocatableCommentableCode ->+                      Code.LocatableCommentableCode+orderImportEntities+  = CodeOrdering.orderRootImportEntities .+      CodeOrdering.orderNestedImportEntities

@@ -3,7 +3,11 @@ -} module Language.Haskell.Formatter.Process.FormatComments (formatComments) where import qualified Data.Function as Function+import qualified Data.Monoid as Monoid+import qualified Language.Haskell.Formatter.ExactCode as ExactCode import qualified Language.Haskell.Formatter.Location as Location+import qualified Language.Haskell.Formatter.Process.AttachComments+       as AttachComments import qualified Language.Haskell.Formatter.Process.Code as Code import qualified Language.Haskell.Formatter.Process.Note as Note import qualified Language.Haskell.Formatter.Result as Result@@ -15,8 +19,64 @@                Style.Style ->                  Code.LocatableCommentableCode ->                    Result.Result Code.LocatableCommentableCode-formatComments _ = return . indentToLineStart . mergeConsecutiveEmptyLines+formatComments style locatableCommentable+  = do locatableCommentable' <- mergeImpliedComments style locatableCommentable+       return . indentToLineStart $+         mergeSuccessiveEmptyLines style locatableCommentable' +mergeImpliedComments ::+                     Style.Style ->+                       Code.LocatableCommentableCode ->+                         Result.Result Code.LocatableCommentableCode+mergeImpliedComments style locatableCommentable+  = do impliedCommentable <- commentsImpliedByLocations style locatable+       commentable' <- commentsDifference style commentable impliedCommentable+       Code.tryZipLocationsComments locatable commentable'+  where locatable = Code.dropComments locatableCommentable+        commentable = Code.dropLocations locatableCommentable++commentsImpliedByLocations ::+                           Style.Style ->+                             Code.LocatableCode ->+                               Result.Result Code.CommentableCode+commentsImpliedByLocations style locatable+  = AttachComments.attachComments style exact+  where exact = ExactCode.create locatable comments+        comments = []++commentsDifference ::+                   Style.Style ->+                     Code.CommentableCode ->+                       Code.CommentableCode ->+                         Result.Result Code.CommentableCode+commentsDifference style = Code.tryZipCode minus+  where minus mixed implied+          = Note.createCommentNote commentsBefore commentsAfter+          where commentsBefore = difference Note.commentsBefore+                difference getComments+                  = Function.on (boxesDifference style) getComments mixed+                      implied+                commentsAfter+                  = reverse . difference $ reverse . Note.commentsAfter++boxesDifference ::+                Style.Style ->+                  [Note.CommentBox] -> [Note.CommentBox] -> [Note.CommentBox]+boxesDifference style mixed implied = Monoid.mappend difference mixedRest+  where difference = replicate differenceCount Note.EmptyLine+        differenceCount+          = if mixedCount <= impliedCount then 0 else+              clip mixedCount - impliedCount+        mixedCount = length mixedEmptyLines+        (mixedEmptyLines, mixedRest) = span isEmptyLine mixed+        impliedCount = length implied+        clip = min successiveEmptyLinesLimit+        successiveEmptyLinesLimit = Style.successiveEmptyLinesLimit style++isEmptyLine :: Note.CommentBox -> Bool+isEmptyLine (Note.ActualComment _) = False+isEmptyLine Note.EmptyLine = True+ indentToLineStart ::                   Code.LocatableCommentableCode -> Code.LocatableCommentableCode indentToLineStart locatableCommentable = locatableCommentable'@@ -33,11 +93,13 @@                 indent = const $ Location.getStartColumn lineStart'         startPosition = Location.getPointLoc . Location.getPortion -mergeConsecutiveEmptyLines ::-                           Code.LocatableCommentableCode ->-                             Code.LocatableCommentableCode-mergeConsecutiveEmptyLines+mergeSuccessiveEmptyLines ::+                          Style.Style ->+                            Code.LocatableCommentableCode ->+                              Code.LocatableCommentableCode+mergeSuccessiveEmptyLines style   = fmap . Note.replaceCommentNote $ Note.replaceCommentBoxes merge-  where merge = ListTool.mergeConsecutiveElements isMerged-        isMerged (Note.ActualComment _) = False-        isMerged Note.EmptyLine = True+  where merge+          = ListTool.mergeLongerSuccessions isEmptyLine+              successiveEmptyLinesLimit+        successiveEmptyLinesLimit = Style.successiveEmptyLinesLimit style

@@ -1,37 +0,0 @@-{-|-Description : Shifting lines of code--}-module Language.Haskell.Formatter.Process.LineShifting-       (Shifter, Shift, createShifter, shiftCode) where-import qualified Data.Map.Strict as Map-import qualified Language.Haskell.Formatter.Location as Location-import qualified Language.Haskell.Formatter.Process.Code as Code--data Shifter = Shifter (Map.Map Location.Line Shift)-             deriving (Eq, Ord, Show)--type Shift = Int--createShifter :: Map.Map Location.Line Shift -> Shifter-createShifter relativeShifter = Shifter absoluteShifter-  where (_, absoluteShifter) = Map.mapAccum accumulate noShift relativeShifter-        accumulate absoluteShift relativeShift-          = (absoluteShift', absoluteShift')-          where absoluteShift' = absoluteShift + relativeShift--noShift :: Shift-noShift = 0--shiftCode :: Shifter -> Code.LocatableCode -> Code.LocatableCode-shiftCode shifter = fmap $ shiftNestedPortion shifter-  where shiftNestedPortion = Location.replaceNestedPortionLines . shiftLine--shiftLine :: Shifter -> Location.Line -> Location.Line-shiftLine shifter line = Location.plus shift line-  where shift = lookupShift line shifter--lookupShift :: Location.Line -> Shifter -> Shift-lookupShift line (Shifter shifter)-  = case Map.lookupLE line shifter of-        Nothing -> noShift-        Just (_, shift) -> shift

@@ -0,0 +1,41 @@+{-|+Description : Working with lines of code+-}+module Language.Haskell.Formatter.Process.LineTool+       (Shifter, Shift, countEmptyLines, createShifter, shiftCode) where+import qualified Data.Map.Strict as Map+import qualified Language.Haskell.Formatter.Location as Location+import qualified Language.Haskell.Formatter.Process.Code as Code++data Shifter = Shifter (Map.Map Location.Line Shift)+             deriving (Eq, Ord, Show)++type Shift = Int++countEmptyLines :: Location.Line -> Location.Line -> Int+countEmptyLines endLine startLine = pred lineDifference+  where lineDifference = Location.minus startLine endLine++createShifter :: Map.Map Location.Line Shift -> Shifter+createShifter relativeShifter = Shifter absoluteShifter+  where (_, absoluteShifter) = Map.mapAccum accumulate noShift relativeShifter+        accumulate absoluteShift relativeShift+          = (absoluteShift', absoluteShift')+          where absoluteShift' = absoluteShift + relativeShift++noShift :: Shift+noShift = 0++shiftCode :: Shifter -> Code.LocatableCode -> Code.LocatableCode+shiftCode shifter = fmap $ shiftNestedPortion shifter+  where shiftNestedPortion = Location.replaceNestedPortionLines . shiftLine++shiftLine :: Shifter -> Location.Line -> Location.Line+shiftLine shifter line = Location.plus shift line+  where shift = lookupShift line shifter++lookupShift :: Location.Line -> Shifter -> Shift+lookupShift line (Shifter shifter)+  = case Map.lookupLE line shifter of+        Nothing -> noShift+        Just (_, shift) -> shift

@@ -2,7 +2,11 @@ Description : Parametrization of formatting -} module Language.Haskell.Formatter.Style-       (Style(..), Indentation, defaultStyle, check) where+       (Style, lineLengthLimit, ribbonsPerLine, successiveEmptyLinesLimit,+        classIndentation, doIndentation, caseIndentation, letIndentation,+        whereIndentation, onsideIndentation, orderImportDeclarations,+        orderImportEntities, Indentation, defaultStyle, check)+       where import qualified Data.Maybe as Maybe import qualified Language.Haskell.Formatter.Error as Error import qualified Language.Haskell.Formatter.Internal.Newline as Newline@@ -10,6 +14,7 @@ import qualified Language.Haskell.Formatter.Source as Source  data Style = Style{lineLengthLimit :: Int, ribbonsPerLine :: Float,+                   successiveEmptyLinesLimit :: Int,                    classIndentation :: Indentation,                    doIndentation :: Indentation, caseIndentation :: Indentation,                    letIndentation :: Indentation,@@ -27,6 +32,7 @@ defaultStyle :: Style defaultStyle   = Style{lineLengthLimit = 80, ribbonsPerLine = 1,+          successiveEmptyLinesLimit = 1,           classIndentation = Source.classIndent mode,           doIndentation = Source.doIndent mode,           caseIndentation = Source.caseIndent mode,@@ -51,8 +57,9 @@ createChecks :: Style -> [Check] createChecks style   = concat-      [[lineLengthLimitCheck, ribbonsPerLineCheck], indentationChecks,-       [onsideLessCheck]]+      [[lineLengthLimitCheck, ribbonsPerLineCheck,+        successiveEmptyLinesLimitCheck],+       indentationChecks, [onsideLessCheck]]   where lineLengthLimitCheck           = createCheck (rawLineLengthLimit > 0)               ["The line length limit must be positive, but it is ",@@ -63,6 +70,12 @@               ["The ribbons per line ratio must be at least 1, but it is ",                show rawRibbonsPerLine, "."]         rawRibbonsPerLine = ribbonsPerLine style+        successiveEmptyLinesLimitCheck+          = createCheck (rawSuccessiveEmptyLinesLimit >= 0)+              ["The successive empty lines limit must not be negative, ",+               "but it is ", show rawSuccessiveEmptyLinesLimit, "."]+        rawSuccessiveEmptyLinesLimit = successiveEmptyLinesLimit style+         indentationChecks = fmap checkIndentation indentations         checkIndentation (indentation, name)           = createCheck (indentation > 0)

@@ -2,13 +2,12 @@ Description : List utilities -} module Language.Haskell.Formatter.Toolkit.ListTool-       (maybeLast, mergeConsecutiveElements, takeEvery, concatenateRuns,-        concatenateShiftedRuns)+       (maybeLast, dropWhileAtMost, mergeLongerSuccessions, takeEvery,+        concatenateRuns, concatenateShiftedRuns)        where import qualified Data.List as List import qualified Data.Maybe as Maybe import qualified Data.Monoid as Monoid-import qualified Data.Word as Word  {-| The last element, or 'Nothing' if there is none. @@ -17,39 +16,47 @@ maybeLast :: [a] -> Maybe a maybeLast = Maybe.listToMaybe . reverse -{-| @mergeConsecutiveElements i l@ keeps only the first element of consecutive-    elements of @l@ satisfying the predicate @i@.+{-| @dropWhileAtMost p l@ is like @dropWhile p@, but drops at most @l@ elements. -    >>> mergeConsecutiveElements Data.Char.isSpace " ab c  d\LF  e  "-    " ab c d\ne "--}-mergeConsecutiveElements :: (a -> Bool) -> [a] -> [a]-mergeConsecutiveElements isMerged = snd . List.foldl' merge (False, [])-  where merge (isConsecutive, list) element = (isConsecutive', list')-          where isConsecutive' = isMerged element-                list' = Monoid.mappend list merged-                merged-                  = if isConsecutive' && isConsecutive then [] else [element]+    >>> dropWhileAtMost (== ' ') 2 "   a bc "+    " a bc " -}+dropWhileAtMost :: (a -> Bool) -> Int -> [a] -> [a]+dropWhileAtMost predicate limit list+  = Monoid.mappend (dropWhile predicate deformable) rigid+  where (deformable, rigid) = splitAt limit list +{-| @mergeLongerSuccessions p c l@ keeps only the first @c@ elements of+    successive elements of @l@ satisfying the predicate @p@.++    >>> mergeLongerSuccessions Data.Char.isSpace 2 "  ab c  d\LF  e   "+    "  ab c  d\n e  " -}+mergeLongerSuccessions :: (a -> Bool) -> Int -> [a] -> [a]+mergeLongerSuccessions predicate count = snd . List.foldl' merge (0, [])+  where merge (successionLength, list) element+          = if predicate element then+              if successionLength < count then (succ successionLength, extended)+                else (count, list)+              else (0, extended)+          where extended = Monoid.mappend list [element]+ {-| @takeEvery p l@ takes every @p@th element of @l@ from the first one.      >>> takeEvery 2 "apple"     "ape"      prop> takeEvery 1 l == l -}-takeEvery :: Word.Word -> [a] -> [a]+takeEvery :: Int -> [a] -> [a] takeEvery _ [] = []-takeEvery period list@(first : _)-  = first : takeEvery period (drop (fromIntegral period) list)+takeEvery period list@(first : _) = first : takeEvery period (drop period list)  {-| @concatenateRuns p l@ repeatedly concatenates @p@ lists of @l@.      >>> concatenateRuns 2 ["a", "b", "c", "d", "e"]     ["ab","cd","e"] -}-concatenateRuns :: Word.Word -> [[a]] -> [[a]]+concatenateRuns :: Int -> [[a]] -> [[a]] concatenateRuns _ [] = [] concatenateRuns period lists = concat run : concatenateRuns period rest-  where (run, rest) = splitAt (fromIntegral period) lists+  where (run, rest) = splitAt period lists  {-| @concatenateShiftedRuns p s l@ first takes @s@ lists of @l@, followed by     repeatedly concatenating @p@ lists.@@ -57,11 +64,11 @@     >>> concatenateShiftedRuns 2 1 ["a", "b", "c", "d", "e"]     ["a","bc","de"] -    prop> p == 0 || concatenateShiftedRuns p 0 l == concatenateRuns p l -}-concatenateShiftedRuns :: Word.Word -> Word.Word -> [[a]] -> [[a]]+    prop> p <= 0 || concatenateShiftedRuns p 0 l == concatenateRuns p l -}+concatenateShiftedRuns :: Int -> Int -> [[a]] -> [[a]] concatenateShiftedRuns period shift lists   = case shift of         0 -> concatenateUnshifted lists         _ -> concat shifted : concatenateUnshifted unshifted-          where (shifted, unshifted) = splitAt (fromIntegral shift) lists+          where (shifted, unshifted) = splitAt shift lists   where concatenateUnshifted = concatenateRuns period

@@ -27,14 +27,14 @@     ["0","1"]     >>> separate ["pine", "pineapple"] "0pineapple1"     ["0","apple1"] -}-separate :: (Eq a) => [[a]] -> [a] -> [[a]]+separate :: Eq a => [[a]] -> [a] -> [[a]] separate = split . createSplitter Drop   where createSplitter rawDelimiterPolicy rawDelimiterQueue           = Splitter{delimiterPolicy = rawDelimiterPolicy,                      delimiterQueue = rawDelimiterQueue}  {-| @split s l@ splits @l@ according to the strategy @s@. -}-split :: (Eq a) => Splitter a -> [a] -> [[a]]+split :: Eq a => Splitter a -> [a] -> [[a]] split splitter list   = case delimiterPolicy splitter of         Drop -> ListTool.takeEvery period parts@@ -48,7 +48,7 @@ {-| @rawSplit s l@ splits @l@ on the sublists @s@, keeping the separators.      prop> odd . length $ separate ["apple", "pine"] l -}-rawSplit :: (Eq a) => [[a]] -> [a] -> [[a]]+rawSplit :: Eq a => [[a]] -> [a] -> [[a]] rawSplit delimiters = move [] []   where move parts left [] = Monoid.mappend parts [left]         move parts left right@(first : rest)@@ -67,6 +67,6 @@     Just ("\r\n","pine")     >>> stripFirstPrefix ["apple"] "pineapple"     Nothing -}-stripFirstPrefix :: (Eq a) => [[a]] -> [a] -> Maybe ([a], [a])+stripFirstPrefix :: Eq a => [[a]] -> [a] -> Maybe ([a], [a]) stripFirstPrefix prefixes list = Visit.findJust strip prefixes   where strip prefix = (,) prefix Applicative.<$> List.stripPrefix prefix list

@@ -18,11 +18,11 @@ findJust function = Foldable.asum . fmap function  {-| @compose f@ returns the function composition of the elements of @f@. -}-compose :: (Foldable.Foldable t) => t (a -> a) -> a -> a+compose :: Foldable.Foldable t => t (a -> a) -> a -> a compose = Monoid.appEndo . Foldable.foldMap Monoid.Endo  {-| @orderByKey k l@ orders @l@ by the sort keys generated by @k@. -}-orderByKey :: (Ord b) => (a -> b) -> [a] -> [a]+orderByKey :: Ord b => (a -> b) -> [a] -> [a] orderByKey = List.sortBy . Ord.comparing  {-| @halfZipWith m b e@ zips the elements of @b@ and @e@ with @m@, using the@@ -40,7 +40,7 @@  {-| Like 'Traversable.mapAccumL', but with a function to create the base. -} mapAccumulateLeftWithCreation ::-                                (Traversable.Traversable t) =>+                                Traversable.Traversable t =>                                 (a -> b -> (a, c)) ->                                   (b -> a) -> t b -> (Maybe a, t c) mapAccumulateLeftWithCreation process createBase

@@ -9,13 +9,16 @@ # Reference: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.38.8777 ribbons_per_line: 1 +# More than this number of empty lines in succession are merged.+successive_empty_lines_limit: 1+ # Indentation lengths in characters. indentations:-    class: 8     # "class" and "instance" declarations.-    do: 3        # "do" notation. -    case: 4      # Body of "case" expressions.-    let: 4       # Declarations in "let" expressions.-    where: 6     # Declarations in "where" clauses.+    class:  8    # "class" and "instance" declarations.+    do:     3    # "do" notation. +    case:   4    # Body of "case" expressions.+    let:    4    # Declarations in "let" expressions.+    where:  6    # Declarations in "where" clauses.     onside: 2    # Continuation lines which would otherwise be offside.  # Decides which parts of the code to sort.

@@ -16,7 +16,7 @@ fileTestForest = folderTestForest readFile  folderTestForest ::-                   (Monoid.Monoid a) =>+                   Monoid.Monoid a =>                    (FilePath -> IO a) ->                      (Either Exception.IOException (Map.Map FilePath a) ->                         [Tasty.TestTree])