hindent 5.1.0 → 5.1.1

raw patch · 9 files changed

+251/−93 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−3
• TESTS.md +87/−2
• hindent.cabal +1/−1
• src/HIndent.hs +71/−46
• src/HIndent/Pretty.hs +36/−12
• src/HIndent/Types.hs +10/−6
• src/main/Main.hs +28/−21
• src/main/Markdone.hs +1/−1
• src/main/Test.hs +1/−1

@@ -1,14 +1,27 @@+5.1.1:++    * Preserve spaces between groups of imports (fixes #200)+    * Support shebangs (closes #208)+    * Output filename for parse errors (fixes #179)+    * Input with newline ends with newline (closes #211)+    * Document -X (closes #212)+    * Fix explicit forall in instances (closes #218)+    * Put last paren of export list on a new line #227+ 5.1.0:-   * Rewrote comment association, more reliable-   * Added --tab-size flag for indentation spaces-   * Fixed some miscellaneous bugs +    * Rewrote comment association, more reliable+    * Added --tab-size flag for indentation spaces+    * Fixed some miscellaneous bugs+ 5.0.1:+     * Re-implement using bytestring instead of text     * Made compatible with GHC 7.8 through to GHC 8.0     * Added test suite and benchmarks in TESTS.md and BENCHMARKS.md  5.0.0:+ 	* Drop support for styles  4.6.4

@@ -24,8 +24,8 @@   ( x   , y   , Z-  , P(x, z))-  where+  , P(x, z)+  ) where ```  ## Imports@@ -49,6 +49,21 @@ type EventSource a = (AddHandler a, a -> IO ()) ``` +Instance declaration without decls++``` haskell+instance C a+```++Instance declaration with decls++``` haskell+instance C a where+    foobar = do+        x y+        k p+```+ # Expressions  Lazy patterns in a lambda@@ -362,6 +377,67 @@  -- This is another random comment. ``` +## Regression tests++cocreature removed from declaration issue #186++``` haskell+-- https://github.com/chrisdone/hindent/issues/186+trans One e n =+    M.singleton+        (Query Unmarked (Mark NonExistent)) -- The goal of this is to fail always+        (emptyImage+         { notPresent = S.singleton (TransitionResult Two (Just A) n)+         })+```++sheyll explicit forall in instances #218++``` haskell+-- https://github.com/chrisdone/hindent/issues/218+instance forall x. C++instance forall x. Show x =>+         C x+```++tfausak support shebangs #208++``` haskell+#!/usr/bin/env stack+-- stack runghc+main = pure ()+-- https://github.com/chrisdone/hindent/issues/208+```++joe9 preserve newlines between import groups++``` haskell+-- https://github.com/chrisdone/hindent/issues/200+import Data.List+import Data.Maybe++import MyProject+import FooBar++import GHC.Monad++-- blah+import Hello++import CommentAfter -- Comment here shouldn't affect newlines+import HelloWorld++import CommentAfter -- Comment here shouldn't affect newlines++import HelloWorld++-- Comment here shouldn't affect newlines+import CommentAfter++import HelloWorld+```+ # Behaviour checks  Unicode@@ -374,6 +450,15 @@ Empty module  ``` haskell+```++Trailing newline is preserved++``` haskell+module X where++foo = 123+ ```  # Complex input

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

@@ -31,6 +31,7 @@ import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Unsafe as S+import           Data.Char import           Data.Either import           Data.Function import           Data.Functor.Identity@@ -45,74 +46,96 @@ import           Language.Haskell.Exts hiding (Style, prettyPrint, Pretty, style, parse) import           Prelude -data CodeBlock = HaskellSource ByteString-               | CPPDirectives ByteString-  deriving (Show, Eq)+-- | A block of code.+data CodeBlock+    = Shebang ByteString+    | HaskellSource ByteString+    | CPPDirectives ByteString+     deriving (Show, Eq)  -- | Format the given source. reformat :: Config -> Maybe [Extension] -> ByteString -> Either String Builder-reformat config mexts x =-  fmap (mconcat . intersperse "\n") (mapM processBlock (cppSplitBlocks x))+reformat config mexts =+    preserveTrailingNewline+        (fmap (mconcat . intersperse "\n") . mapM processBlock . cppSplitBlocks)   where     processBlock :: CodeBlock -> Either String Builder+    processBlock (Shebang text) = Right $ S.byteString text     processBlock (CPPDirectives text) = Right $ S.byteString text     processBlock (HaskellSource text) =-      let ls = S8.lines text-          prefix = findPrefix ls-          code = unlines' (map (stripPrefix prefix) ls)-      in case parseModuleWithComments mode' (UTF8.toString code) of-        ParseOk (m, comments) ->-          fmap (S.lazyByteString .-          addPrefix prefix .-          S.toLazyByteString)-          (prettyPrint config m comments)-        ParseFailed _ e -> Left e-+        let ls = S8.lines text+            prefix = findPrefix ls+            code = unlines' (map (stripPrefix prefix) ls)+        in case parseModuleWithComments mode' (UTF8.toString code) of+               ParseOk (m, comments) ->+                   fmap+                       (S.lazyByteString . addPrefix prefix . S.toLazyByteString)+                       (prettyPrint config m comments)+               ParseFailed _ e -> Left e     unlines' = S.concat . intersperse "\n"     unlines'' = L.concat . intersperse "\n"-     addPrefix :: ByteString -> L8.ByteString -> L8.ByteString     addPrefix prefix = unlines'' . map (L8.fromStrict prefix <>) . L8.lines-     stripPrefix :: ByteString -> ByteString -> ByteString     stripPrefix prefix line =-      if S.null (S8.dropWhile (== '\n') line)-      then line-      else fromMaybe (error "Missing expected prefix") . s8_stripPrefix prefix $ line-+        if S.null (S8.dropWhile (== '\n') line)+            then line+            else fromMaybe (error "Missing expected prefix") . s8_stripPrefix prefix $+                 line     findPrefix :: [ByteString] -> ByteString     findPrefix = takePrefix False . findSmallestPrefix . dropNewlines-     dropNewlines :: [ByteString] -> [ByteString]     dropNewlines = filter (not . S.null . S8.dropWhile (== '\n'))-     takePrefix :: Bool -> ByteString -> ByteString     takePrefix bracketUsed txt =-      case S8.uncons txt of-        Nothing -> ""-        Just ('>', txt') -> if not bracketUsed-                              then S8.cons '>' (takePrefix True txt')-                              else ""-        Just (c, txt') -> if c == ' ' || c == '\t'-                            then S8.cons c (takePrefix bracketUsed txt')-                            else ""--+        case S8.uncons txt of+            Nothing -> ""+            Just ('>', txt') ->+                if not bracketUsed+                    then S8.cons '>' (takePrefix True txt')+                    else ""+            Just (c, txt') ->+                if c == ' ' || c == '\t'+                    then S8.cons c (takePrefix bracketUsed txt')+                    else ""     findSmallestPrefix :: [ByteString] -> ByteString     findSmallestPrefix [] = ""     findSmallestPrefix ("":_) = ""     findSmallestPrefix (p:ps) =-      let first = S8.head p-          startsWithChar c x  = S8.length x > 0 && S8.head x == c-      in if all (startsWithChar first) ps-           then S8.cons first (findSmallestPrefix (S.tail p : map S.tail ps))-           else ""-+        let first = S8.head p+            startsWithChar c x = S8.length x > 0 && S8.head x == c+        in if all (startsWithChar first) ps+               then S8.cons+                        first+                        (findSmallestPrefix (S.tail p : map S.tail ps))+               else ""     mode' =-      case mexts of-        Just exts -> parseMode { extensions = exts }-        Nothing   -> parseMode+        case mexts of+            Just exts ->+                parseMode+                { extensions = exts+                }+            Nothing -> parseMode+    preserveTrailingNewline f x =+        if S8.null x || S8.all isSpace x+            then return mempty+            else if hasTrailingLine x || configTrailingNewline config+                     then fmap+                              (\x' ->+                                    if hasTrailingLine+                                           (L.toStrict (S.toLazyByteString x'))+                                        then x'+                                        else x' <> "\n")+                              (f x)+                     else f x +-- | Does the strict bytestring have a trailing newline?+hasTrailingLine :: ByteString -> Bool+hasTrailingLine xs =+    if S8.null xs+        then False+        else S8.last xs == '\n'+ -- | 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@@ -140,9 +163,11 @@         ["#if", "#end", "#else", "#define", "#undef", "#elif"]     classify :: ByteString -> CodeBlock     classify text =-      if cppLine text-        then CPPDirectives text-        else HaskellSource text+      if S8.isPrefixOf "#!" text+         then Shebang text+         else 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.

@@ -763,15 +763,19 @@                             (prefixedLined "|"                                            (map (depend space . pretty) xs))) -decl (InlineSig _ inline _ name) = do+decl (InlineSig _ inline active name) = do   write "{-# "    unless inline $ write "NO"   write "INLINE "+  case active of+    Nothing -> return ()+    Just (ActiveFrom _ x) -> write ("[" ++ show x ++ "] ")+    Just (ActiveUntil _ x) -> write ("[~" ++ show x ++ "] ")   pretty name    write " #-}"-decl x = pretty' x+decl x' = pretty' x'  instance Pretty Deriving where   prettyInternal (Deriving _ heads) =@@ -825,8 +829,8 @@       NoStrictAnnot _ -> return ()  instance Pretty Unpackedness where-  prettyInternal (Unpack _) = write "{-# UNPACK -#}"-  prettyInternal (NoUnpack _) = write "{-# NOUNPACK -#}"+  prettyInternal (Unpack _) = write "{-# UNPACK #-}"+  prettyInternal (NoUnpack _) = write "{-# NOUNPACK #-}"   prettyInternal (NoUnpackPragma _) = return ()  instance Pretty Binds where@@ -973,7 +977,9 @@   prettyInternal (IRule _ mvarbinds mctx ihead) =     do case mvarbinds of          Nothing -> return ()-         Just xs -> spaced (map pretty xs)+         Just xs -> do write "forall "+                       spaced (map pretty xs)+                       write ". "        withCtx mctx (pretty ihead)  instance Pretty InstHead where@@ -1035,7 +1041,7 @@                            ,(case mayModHead of                                Nothing -> (True,return ())                                Just modHead -> (False,pretty modHead))-                           ,(null imps,inter newline (map pretty imps))+                           ,(null imps,formatImports imps)                            ,(null decls                             ,interOf newline                                      (map (\case@@ -1054,6 +1060,24 @@       XmlPage{} -> error "FIXME: No implementation for XmlPage."       XmlHybrid{} -> error "FIXME: No implementation for XmlHybrid." +-- | Format imports, preserving empty newlines between them.+formatImports :: [ImportDecl NodeInfo] -> Printer ()+formatImports imps =+    mapM_ formatImport (zip [1 ..] (zip (Nothing : map Just imps) imps))+  where+    formatImport (i, (mprev, current)) = do+        when (difference > 1) newline+        pretty current+        unless (i == length imps) newline+      where+        difference =+            case mprev of+                Nothing -> 0+                Just prev ->+                    fst+                        (srcSpanStart (srcInfoSpan (nodeInfoSpan (ann current)))) -+                    fst (srcSpanStart (srcInfoSpan (nodeInfoSpan (ann prev))))+ instance Pretty Bracket where   prettyInternal x =     case x of@@ -1158,9 +1182,7 @@        maybe (return ())              (\exports ->                 do newline-                   indented 2 (pretty exports)-                   newline-                   space)+                   indented 2 (pretty exports))              mexports        write " where" @@ -1187,9 +1209,11 @@     write "{-# WARNING " >> string s >> write " #-}"  instance Pretty ExportSpecList where-  prettyInternal (ExportSpecList _ es) =-    parens (prefixedLined ","-                          (map pretty es))+  prettyInternal (ExportSpecList _ es) = do+    depend (write "(")+           (prefixedLined "," (map pretty es))+    newline+    write ")"  instance Pretty ExportSpec where   prettyInternal x = string " " >> pretty' x

@@ -54,16 +54,20 @@  -- | Configurations shared among the different styles. Styles may pay -- attention to or completely disregard this configuration.-data Config =-  Config {configMaxColumns :: !Int64 -- ^ Maximum columns to fit code into ideally.-         ,configIndentSpaces :: !Int64 -- ^ How many spaces to indent?-         }+data Config = Config+    { configMaxColumns :: !Int64 -- ^ Maximum columns to fit code into ideally.+    , configIndentSpaces :: !Int64 -- ^ How many spaces to indent?+    , configTrailingNewline :: !Bool -- ^ End with a newline.+    }  -- | Default style configuration. defaultConfig :: Config defaultConfig =-  Config {configMaxColumns = 80-         ,configIndentSpaces = 4}+    Config+    { configMaxColumns = 80+    , configIndentSpaces = 4+    , configTrailingNewline = True+    }  data NodeComment   = CommentSameLine String

@@ -36,42 +36,43 @@ main = do     args <- getArgs     case consume options (map T.pack args) of-        Succeeded (style,exts,mfilepath) ->+        Succeeded (style, exts, mfilepath) ->             case mfilepath of                 Just filepath -> do                     text <- S.readFile filepath                     tmpDir <- getTemporaryDirectory-                    (fp,h) <- openTempFile tmpDir "hindent.hs"-                    L8.putStrLn-                                   (either-                                        error-                                        S.toLazyByteString-                                        (reformat style (Just exts) text))-                    hFlush h-                    hClose h-                    let exdev e =-                            if ioe_errno e ==-                               Just-                                   ((\(Errno a) ->-                                          a)-                                        eXDEV)-                                then copyFile fp filepath >> removeFile fp-                                else throw e-                    renameFile fp filepath `catch` exdev+                    (fp, h) <- openTempFile tmpDir "hindent.hs"+                    case reformat style (Just exts) text of+                        Left e -> error (filepath ++ ": " ++ e)+                        Right out -> do+                            L8.hPutStr h (S.toLazyByteString out)+                            hFlush h+                            hClose h+                            let exdev e =+                                    if ioe_errno e ==+                                       Just ((\(Errno a) -> a) eXDEV)+                                        then copyFile fp filepath >>+                                             removeFile fp+                                        else throw e+                            renameFile fp filepath `catch` exdev                 Nothing ->                     L8.interact-                           (either error S.toLazyByteString . reformat style (Just exts) . L8.toStrict)+                        (either error S.toLazyByteString .+                         reformat style (Just exts) . L8.toStrict)         Failed (Wrap (Stopped Version) _) ->             putStrLn ("hindent " ++ showVersion version)         Failed (Wrap (Stopped Help) _) -> putStrLn help         _ -> error help   where ++ help :: [Char] help =     "hindent " ++     T.unpack (textDescription (describe options [])) ++     "\nVersion " ++ showVersion version ++ "\n" +++    "-X to pass extensions e.g. -XMagicHash etc.\n" ++     "The --style option is now ignored, but preserved for backwards-compatibility.\n" ++     "Johan Tibell is the default and only style." @@ -94,7 +95,9 @@             (optional                  (constant "--style" "Style to print with" () *>                   anyString "STYLE")) <*>-        lineLen <*> tabsize+        lineLen <*>+        tabsize <*>+        trailingNewline     exts = fmap getExtensions (many (prefix "X" "Language extension"))     tabsize =         fmap@@ -104,9 +107,13 @@         fmap             (>>= (readMaybe . T.unpack))             (optional (arg "line-length" "Desired length of lines"))-    makeStyle s mlen tabs =+    trailingNewline =+        optional+            (constant "--no-force-newline" "Don't force a trailing newline" False)+    makeStyle s mlen tabs trailing =         s         { configMaxColumns = fromMaybe (configMaxColumns s) mlen         , configIndentSpaces = fromMaybe (configIndentSpaces s) tabs+        , configTrailingNewline = fromMaybe (configTrailingNewline s) trailing         }     file = fmap (fmap T.unpack) (optional (anyString "[<filename>]"))

@@ -48,7 +48,7 @@ tokenize = map token . S8.lines   where     token line =-      if S8.isPrefixOf "#" line+      if S8.isPrefixOf "#" line && not (S8.isPrefixOf "#!" line)         then let (hashes,title) = S8.span (== '#') line              in Heading (S8.length hashes) (S8.dropWhile isSpace title)         else if S8.isPrefixOf "```" line

@@ -44,7 +44,7 @@                   (("-- " <>) . L8.pack)                   L.toLazyByteString                   (reformat-                     HIndent.Types.defaultConfig+                     HIndent.Types.defaultConfig {configTrailingNewline = False}                      (Just defaultExtensions)                      code))                (L.fromStrict code))