diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# Floskell 0.10.5 (2020-09-21) + +* Fix indentation of nested list and tuple expressions +* Fix formatting of slightly overlong module headers +* Fix formatting of promoted types + # Floskell 0.10.4 (2020-08-05) * Fix formatting of type applications diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,9 @@ -# Floskell [![Build Status](https://travis-ci.org/ennocramer/floskell.png)](https://travis-ci.org/ennocramer/floskell) +# Floskell +[![Hackage][hackage-image]][hackage-url] +[![Build Status][ci-image]][ci-url] +[![License][license-image]][license-url] + Floskell is a flexible Haskell source code pretty printer. [Documentation](https://github.com/ennocramer/floskell/blob/master/README.md) @@ -323,3 +327,11 @@ should be installed as package into `.atom\packages\${PACKAGE_NAME}`, here is simple example of atom [package](https://github.com/Heather/atom-hindent). + + +[hackage-image]: https://img.shields.io/hackage/v/floskell.svg?style=flat +[hackage-url]: https://hackage.haskell.org/package/floskell +[ci-image]: https://github.com/ennocramer/floskell/workflows/CI%20Pipeline/badge.svg +[ci-url]: https://github.com/ennocramer/floskell/actions?query=workflow%3A%22CI+Pipeline%22 +[license-image]: https://img.shields.io/badge/license-BSD--3--Clause-blue?style=flat-square +[license-url]: https://github.com/ennocramer/floskell/blob/master/LICENSE.md diff --git a/TEST.md b/TEST.md --- a/TEST.md +++ b/TEST.md @@ -716,6 +716,12 @@ } ``` +Promoted types. + +``` haskell +type Foo = Bar 1 "foo" '() '(A, B) '[X, Y] +``` + ## Patterns Long function pattern matches allow linebreaks. @@ -875,4 +881,12 @@ > | Two -- Bar > | Three -- Baz > +``` + +## Module Exports + +Long module exports don't force overlong line. + +``` haskell +module SimpleFunctions ( identity, compose, append, firstElement, secondElem ) where ``` diff --git a/floskell.cabal b/floskell.cabal --- a/floskell.cabal +++ b/floskell.cabal @@ -1,110 +1,127 @@ -name: floskell -version: 0.10.4 -synopsis: A flexible Haskell source code pretty printer -description: A flexible Haskell source code pretty printer. - . - See the Github page for usage\/explanation: -license: BSD3 -stability: Unstable -license-file: LICENSE.md -author: Chris Done, Andrew Gibiansky, Tobias Pflug, Pierre Radermecker, Enno Cramer -maintainer: ecramer@memfrob.de -copyright: 2014 Chris Done, 2015 Andrew Gibiansky, 2016-2020 Enno Cramer -category: Development -build-type: Simple -cabal-version: >=1.10 -homepage: https://github.com/ennocramer/floskell -bug-reports: https://github.com/ennocramer/floskell/issues -data-files: contrib/floskell.el - contrib/floskell.coffee -extra-source-files: README.md - CHANGELOG.md - BENCHMARK.md - TEST.md - stack.yaml +cabal-version: >=1.10 +name: floskell +version: 0.10.5 +license: BSD3 +license-file: LICENSE.md +copyright: + 2014 Chris Done, 2015 Andrew Gibiansky, 2016-2020 Enno Cramer +maintainer: ecramer@memfrob.de +author: + Chris Done, Andrew Gibiansky, Tobias Pflug, Pierre Radermecker, Enno Cramer + +stability: Unstable +homepage: https://github.com/ennocramer/floskell +bug-reports: https://github.com/ennocramer/floskell/issues +synopsis: A flexible Haskell source code pretty printer +description: + A flexible Haskell source code pretty printer. + . + See the Github page for usage\/explanation: + +category: Development +build-type: Simple +data-files: + contrib/floskell.el + contrib/floskell.coffee + +extra-source-files: + README.md + CHANGELOG.md + BENCHMARK.md + TEST.md + stack.yaml + source-repository head - type: git - location: https://github.com/ennocramer/floskell + type: git + location: https://github.com/ennocramer/floskell library - hs-source-dirs: src/ - default-language: Haskell2010 - ghc-options: -Wall - exposed-modules: Floskell - Floskell.Attoparsec - Floskell.Buffer - Floskell.Comments - Floskell.Config - Floskell.ConfigFile - Floskell.Fixities - Floskell.Imports - Floskell.Pretty - Floskell.Printers - Floskell.Styles - Floskell.Types - build-depends: base >=4.9 && <4.15 - , aeson >=0.11.3.0 && <1.6 - , attoparsec >=0.13.1.0 && <0.14 - , bytestring >=0.10.8.1 && <0.11 - , containers >=0.5.7.1 && <0.7 - , data-default >=0.7.1.1 && <0.8 - , directory >=1.2.6.2 && <1.4 - , filepath >=1.4.1.0 && <1.5 - , haskell-src-exts >= 1.19 && <1.24 - , monad-dijkstra >=0.1.1 && <0.2 - , mtl >=2.2.1 && <2.3 - , text >=1.2.2.2 && <1.3 - , transformers >=0.5.2.0 && <0.6 - , unordered-containers >=0.2.8.0 && <0.3 - , utf8-string >=1.0.1.1 && <1.1 + exposed-modules: + Floskell + Floskell.Attoparsec + Floskell.Buffer + Floskell.Comments + Floskell.Config + Floskell.ConfigFile + Floskell.Fixities + Floskell.Imports + Floskell.Pretty + Floskell.Printers + Floskell.Styles + Floskell.Types + hs-source-dirs: src/ + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4.9 && <4.15, + aeson >=0.11.3.0 && <1.6, + attoparsec >=0.13.1.0 && <0.14, + bytestring >=0.10.8.1 && <0.11, + containers >=0.5.7.1 && <0.7, + data-default >=0.7.1.1 && <0.8, + directory >=1.2.6.2 && <1.4, + filepath >=1.4.1.0 && <1.5, + haskell-src-exts >=1.19 && <1.24, + monad-dijkstra >=0.1.1 && <0.2, + mtl >=2.2.1 && <2.3, + text >=1.2.2.2 && <1.3, + transformers >=0.5.2.0 && <0.6, + unordered-containers >=0.2.8.0 && <0.3, + utf8-string >=1.0.1.1 && <1.1 + executable floskell - hs-source-dirs: src/main - default-language: Haskell2010 - ghc-options: -Wall -Wno-missing-home-modules -optP-Wno-nonportable-include-path - main-is: Main.hs - build-depends: base >=4.9 && <4.15 - , floskell - , aeson-pretty >=0.8.2 && <0.9 - , bytestring >=0.10.8.1 && <0.11 - , directory >=1.2.6.2 && <1.4 - , ghc-prim >=0.5.0.0 && <0.7 - , haskell-src-exts >= 1.19 && <1.24 - , optparse-applicative >=0.12.1.0 && <0.16 - , text >=1.2.2.2 && <1.3 + main-is: Main.hs + hs-source-dirs: src/main + default-language: Haskell2010 + ghc-options: + -Wall -Wno-missing-home-modules -optP-Wno-nonportable-include-path + build-depends: + base >=4.9 && <4.15, + floskell -any, + aeson-pretty >=0.8.2 && <0.9, + bytestring >=0.10.8.1 && <0.11, + directory >=1.2.6.2 && <1.4, + ghc-prim >=0.5.0.0 && <0.7, + haskell-src-exts >=1.19 && <1.24, + optparse-applicative >=0.12.1.0 && <0.17, + text >=1.2.2.2 && <1.3 + test-suite floskell-test - type: exitcode-stdio-1.0 - hs-source-dirs: src/main - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - main-is: Test.hs - other-modules: Markdone - build-depends: base >=4.9 && <4.15 - , floskell - , bytestring >=0.10.8.1 && <0.11 - , deepseq >=1.4.2.0 && <1.5 - , exceptions >=0.8.3 && <0.12 - , haskell-src-exts >= 1.19 && <1.24 - , hspec >=2.2.4 && <2.8 - , text >=1.2.2.2 && <1.3 - , utf8-string >=1.0.1.1 && <1.1 + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: src/main + other-modules: Markdone + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.9 && <4.15, + floskell -any, + bytestring >=0.10.8.1 && <0.11, + deepseq >=1.4.2.0 && <1.5, + exceptions >=0.8.3 && <0.12, + haskell-src-exts >=1.19 && <1.24, + hspec >=2.2.4 && <2.8, + text >=1.2.2.2 && <1.3, + utf8-string >=1.0.1.1 && <1.1 benchmark floskell-bench - type: exitcode-stdio-1.0 - hs-source-dirs: src/main - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - main-is: Benchmark.hs - other-modules: Markdone - build-depends: base >=4.9 && <4.15 - , floskell - , bytestring >=0.10.8.1 && <0.11 - , criterion >=1.1.1.0 && <1.6 - , deepseq >=1.4.2.0 && <1.5 - , exceptions >=0.8.3 && <0.11 - , ghc-prim >=0.5.0.0 && <0.7 - , haskell-src-exts >= 1.19 && < 1.24 - , text >=1.2.2.2 && <1.3 - , utf8-string >=1.0.1.1 && <1.1 + type: exitcode-stdio-1.0 + main-is: Benchmark.hs + hs-source-dirs: src/main + other-modules: Markdone + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.9 && <4.15, + floskell -any, + bytestring >=0.10.8.1 && <0.11, + criterion >=1.1.1.0 && <1.6, + deepseq >=1.4.2.0 && <1.5, + exceptions >=0.8.3 && <0.11, + ghc-prim >=0.5.0.0 && <0.7, + haskell-src-exts >=1.19 && <1.24, + text >=1.2.2.2 && <1.3, + utf8-string >=1.0.1.1 && <1.1 diff --git a/src/Floskell.hs b/src/Floskell.hs --- a/src/Floskell.hs +++ b/src/Floskell.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} diff --git a/src/Floskell/Config.hs b/src/Floskell/Config.hs --- a/src/Floskell/Config.hs +++ b/src/Floskell/Config.hs @@ -268,8 +268,7 @@ def { cfgOp = OpConfig ((unOpConfig def) { cfgMapOverrides = Map.fromList opWsOverrides }) - , cfgGroup = GroupConfig ((unGroupConfig def) { cfgMapOverrides = - Map.fromList groupWsOverrides + , cfgGroup = GroupConfig ((unGroupConfig def) { cfgMapOverrides = Map.fromList groupWsOverrides }) } where diff --git a/src/Floskell/Pretty.hs b/src/Floskell/Pretty.hs --- a/src/Floskell/Pretty.hs +++ b/src/Floskell/Pretty.hs @@ -189,7 +189,8 @@ let correction = case loc of Before -> col - srcSpanStartColumn ssi + 1 After -> col - srcSpanEndColumn ssi + 1 - forM_ (zip comments (tail (map commentSpan comments ++ [ssi]))) $ printComment correction + forM_ (zip comments (tail (map commentSpan comments ++ [ ssi ]))) $ + printComment correction -- Write newline before restoring onside indent. eol <- gets psEolComment @@ -283,14 +284,14 @@ sepCol = itemCol - delta column itemCol $ do printComments' Before x - cut . onside $ prettyPrint x + cut $ prettyPrint x printComments After x -- `column sepCol` must not be within `column itemCol`, or the -- former can suppress onside for the latter. forM_ xs' $ \x' -> do column itemCol $ printComments Before x' column sepCol $ operatorV ctx sep - column itemCol $ cut . onside $ prettyPrint x' + column itemCol $ cut $ prettyPrint x' column itemCol $ printComments After x' listH :: (Annotated ast, Pretty ast) @@ -388,12 +389,21 @@ else BS.length sep + if wsSpace After ws then 1 else 0 col <- getNextColumn pretty x - forM_ xs $ \x' -> do + go (col - correction) xs + where + go _ [] = return () + go col [x'] = do printComments Before x' + column col $ operator ctx sep + prettyPrint x' + printComments After x' + go col (x':xs') = do + printComments Before x' cut $ do - column (col - correction) $ operator ctx sep + column col $ operator ctx sep prettyPrint x' printComments After x' + go col xs' measure :: Printer a -> Printer (Maybe Int) measure p = do @@ -616,9 +626,9 @@ atTabStop stopRecordField withIndentConfig cfgIndentTypesig align indentby where - align = alignOnOperator ctx "::" $ pretty ty + align = onside . alignOnOperator ctx "::" $ pretty ty - indentby i = indentedBy i $ do + indentby i = indented i $ do operator ctx "::" nl <- gets psNewline when nl $ do @@ -678,16 +688,11 @@ where flex = do withOperatorFormattingH ctx "record" (pretty name) id - groupH ctx "{" "}" $ inter (operatorH ctx ",") $ - map prettyOnside fields + prettyRecordFields len ctx fields vertical = do withOperatorFormatting ctx "record" (pretty name) id - groupV ctx "{" "}" $ withComputedTabStop stopRecordField - cfgAlignRecordFields - (fmap (fmap pure) . len) - fields $ - listVinternal ctx "," fields + prettyRecordFields len ctx fields prettyRecordFields :: (Annotated ast, Pretty ast) => (ast NodeInfo -> Printer (Maybe Int)) @@ -738,26 +743,26 @@ depend "module" $ do pretty name mayM_ mwarning $ withPrefix spaceOrNewline pretty - mayM_ mexports pretty - write " where" + withLayout cfgLayoutExportSpecList flex vertical + where + flex = do + mayM_ mexports $ \(ExportSpecList _ exports) -> do + space + listAutoWrap Other "(" ")" "," exports + write " where" + vertical = do + mayM_ mexports $ \(ExportSpecList _ exports) -> do + withIndent cfgIndentExportSpecList $ + listV Other "(" ")" "," exports + write " where" + instance Pretty WarningText where prettyPrint (DeprText _ s) = write "{-# DEPRECATED " >> string (show s) >> write " #-}" prettyPrint (WarnText _ s) = write "{-# WARNING " >> string (show s) >> write " #-}" -instance Pretty ExportSpecList where - prettyPrint (ExportSpecList _ exports) = - withLayout cfgLayoutExportSpecList flex vertical - where - flex = do - space - listAutoWrap Other "(" ")" "," exports - - vertical = withIndent cfgIndentExportSpecList $ - listV Other "(" ")" "," exports - instance Pretty ExportSpec instance Pretty ImportDecl where @@ -973,7 +978,8 @@ prettyPrint (PatSyn _ pat pat' patternsyndirection) = do depend "pattern" $ prettySimpleDecl pat sep pat' case patternsyndirection of - ExplicitBidirectional _ decls -> prettyBinds (BDecls noNodeInfo decls) + ExplicitBidirectional _ decls -> + prettyBinds (BDecls noNodeInfo decls) _ -> return () where sep = case patternsyndirection of @@ -1147,8 +1153,10 @@ prettyPrint (ClsTyDef _ typeeqn) = depend "type" $ pretty typeeqn - prettyPrint (ClsDefSig _ name ty) = - depend "default" $ prettyTypesig Declaration [ name ] ty + prettyPrint (ClsDefSig _ name ty) = do + write "default" + space + prettyTypesig Declaration [ name ] ty instance Pretty InstDecl where prettyPrint (InsDecl _ decl) = pretty decl @@ -1337,6 +1345,7 @@ prettyPrint (TypeA _ ty) = pretty ty prettyPrint (IParam _ ipname ty) = prettyTypesig Declaration [ ipname ] ty prettyPrint (ParenA _ asst) = parens $ pretty asst + #else instance Pretty Asst where prettyPrint (ClassA _ qname types) = do @@ -1446,7 +1455,7 @@ operator Type "::" pretty kind - prettyF ty@(TyPromoted _ _promoted) = prettyHSE ty + prettyF (TyPromoted _ promoted) = pretty promoted prettyF (TyEquals _ ty ty') = do pretty ty @@ -1460,7 +1469,7 @@ pretty bangtype pretty ty - prettyF ty@(TyWildCard _ _mname) = prettyHSE ty + prettyF ty@(TyWildCard _ _mname) = prettyHSE ty -- FIXME prettyF (TyQuasiQuote _ str str') = do write "[" @@ -1516,6 +1525,28 @@ prettyPrint (KindList _ kind) = group Type "'[" "]" $ pretty kind #endif +instance Pretty Promoted where + prettyPrint (PromotedInteger _ _ str) = string str + + prettyPrint (PromotedString _ _ str) = do + write "\"" + string str + write "\"" + + prettyPrint (PromotedCon _ quote qname) = do + when quote $ write "'" + pretty qname + + prettyPrint (PromotedList _ quote tys) = do + when quote $ write "'" + list Expression "[" "]" "," tys + + prettyPrint (PromotedTuple _ tys) = do + write "'" + list Expression "(" ")" "," tys + + prettyPrint (PromotedUnit _) = write "'()" + instance Pretty TyVarBind where prettyPrint (KindedVar _ name kind) = parens $ do pretty name @@ -2102,15 +2133,6 @@ operator Expression "<-" pretty expr - -- Special case for If in Do, - prettyPrint (Qualifier _ expr@If{}) = do - cfg <- getConfig (cfgIndentIf . cfgIndent) - case cfg of - Align -> do - write "" - indented $ pretty expr - _ -> pretty expr - prettyPrint (Qualifier _ expr) = pretty expr prettyPrint (LetStmt _ binds) = do @@ -2124,9 +2146,10 @@ instance Pretty FieldUpdate where prettyPrint (FieldUpdate _ qname expr) = do pretty qname - atTabStop stopRecordField - operator Expression "=" - pretty expr + onside $ do + atTabStop stopRecordField + operator Expression "=" + pretty expr prettyPrint (FieldPun _ qname) = pretty qname @@ -2144,7 +2167,8 @@ prettyPrint (ExpBracket _ expr) = group Expression "[|" "|]" $ pretty expr #if MIN_VERSION_haskell_src_exts(1,22,0) - prettyPrint (TExpBracket _ expr) = group Expression "[||" "||]" $ pretty expr + prettyPrint (TExpBracket _ expr) = + group Expression "[||" "||]" $ pretty expr #endif prettyPrint (PatBracket _ pat) = group Expression "[p|" "|]" $ pretty pat @@ -2167,7 +2191,6 @@ string str prettyPrint (TParenSplice _ expr) = group Expression "$$(" ")" $ pretty expr - #endif instance Pretty ModulePragma where diff --git a/src/Floskell/Printers.hs b/src/Floskell/Printers.hs --- a/src/Floskell/Printers.hs +++ b/src/Floskell/Printers.hs @@ -33,7 +33,6 @@ , column , aligned , indented - , indentedBy , onside , depend , depend' @@ -48,8 +47,6 @@ , operatorH , operatorV , alignOnOperator - , alignOnOperatorH - , alignOnOperatorV , withOperatorFormatting , withOperatorFormattingH , withOperatorFormattingV @@ -228,7 +225,7 @@ space aligned p - indentby i = indentedBy i $ do + indentby i = indented i $ do newline p @@ -239,7 +236,7 @@ space aligned p - indentby i = indentedBy i $ do + indentby i = indented i $ do spaceOrNewline p @@ -253,7 +250,7 @@ indentby i = do withIndentation id before - indentedBy i p + indented i p withIndentBy :: (IndentConfig -> Int) -> Printer a -> Printer a withIndentBy fn = withIndent (IndentBy . fn) @@ -297,14 +294,9 @@ col <- getNextColumn column col p -indented :: Printer a -> Printer a -indented p = do - i <- getConfig (cfgIndentOnside . cfgIndent) - indentedBy i p - -- | Increase indentation level by n spaces for the given printer. -indentedBy :: Int -> Printer a -> Printer a -indentedBy i p = do +indented :: Int -> Printer a -> Printer a +indented i p = do level <- gets psIndentLevel column (level + i) p @@ -321,9 +313,10 @@ depend' :: Printer () -> Printer a -> Printer a depend' kw p = do + i <- getConfig (cfgIndentOnside . cfgIndent) kw space - indented p + indented i p -- | Wrap in parens. parens :: Printer () -> Printer () @@ -380,14 +373,6 @@ alignOnOperator :: LayoutContext -> ByteString -> Printer a -> Printer a alignOnOperator ctx op p = withOperatorFormatting ctx op (write op) (aligned . (*> p)) - -alignOnOperatorH :: LayoutContext -> ByteString -> Printer a -> Printer a -alignOnOperatorH ctx op p = - withOperatorFormattingH ctx op (write op) (aligned . (*> p)) - -alignOnOperatorV :: LayoutContext -> ByteString -> Printer a -> Printer a -alignOnOperatorV ctx op p = - withOperatorFormattingV ctx op (write op) (aligned . (*> p)) withOperatorFormatting :: LayoutContext -> ByteString diff --git a/src/Floskell/Styles.hs b/src/Floskell/Styles.hs --- a/src/Floskell/Styles.hs +++ b/src/Floskell/Styles.hs @@ -90,14 +90,13 @@ } cramerCfg :: Config -cramerCfg = - defaultConfig { cfgAlign - , cfgIndent - , cfgLayout - , cfgOp - , cfgGroup - , cfgOptions - } +cramerCfg = defaultConfig { cfgAlign + , cfgIndent + , cfgLayout + , cfgOp + , cfgGroup + , cfgOptions + } where cfgAlign = AlignConfig { cfgAlignLimits = (10, 25) , cfgAlignCase = False @@ -189,9 +188,7 @@ , ( ConfigMapKey (Just "[") (Just Pattern) , Whitespace WsBoth WsAfter False ) - , ( ConfigMapKey (Just "[") (Just Type) - , Whitespace WsNone WsNone False - ) + , (ConfigMapKey (Just "[") (Just Type), Whitespace WsNone WsNone False) ] cfgOptions = @@ -206,14 +203,13 @@ } gibianskyCfg :: Config -gibianskyCfg = - defaultConfig { cfgAlign - , cfgIndent - , cfgLayout - , cfgOp - , cfgGroup - , cfgOptions - } +gibianskyCfg = defaultConfig { cfgAlign + , cfgIndent + , cfgLayout + , cfgOp + , cfgGroup + , cfgOptions + } where cfgAlign = AlignConfig { cfgAlignLimits = (10, 25) , cfgAlignCase = True