From 01e31b4256135d594ddc75cb36ef494d0a7ba875 Mon Sep 17 00:00:00 2001 From: Rupert Horlick Date: Sun, 14 Oct 2018 14:28:43 -0400 Subject: [PATCH 01/11] Add type fam instance formatting --- src-literatetests/10-tests.blt | 41 ++++++ .../Brittany/Internal/LayouterBasics.hs | 54 +++++--- .../Brittany/Internal/Layouters/Decl.hs | 129 +++++++++++------- 3 files changed, 159 insertions(+), 65 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 15a021e..63e93c0 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -1141,3 +1141,44 @@ func = do other :: Other other = True + + +############################################################################### +############################################################################### +############################################################################### +#group typefam.instance +############################################################################### +############################################################################### +############################################################################### + +#test simple-typefam-instance + +type instance MyFam Bool = String + +#test simple-typefam-instance-param-type + +type instance MyFam (Maybe a) = a -> Bool + +#test simple-typefam-instance-parens + +type instance (MyFam (String -> Int)) = String + +#test simple-typefam-instance-overflow + +type instance MyFam ALongishType + = AMuchLongerTypeThanThat + -> AnEvenLongerTypeThanTheLastOne + -> ShouldDefinitelyOverflow + +#test simple-typefam-instance-comments + +-- | A happy family +type instance MyFam Bool -- This is an odd one + = AnotherType -- Here's another + +#test simple-typefam-instance-parens-comment + +-- | A happy family +type instance (MyFam Bool) -- This is an odd one + = -- Here's another + AnotherType diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 6352662..977e8e8 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -9,6 +9,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick , askIndent , extractAllComments + , extractRestComments , filterAnns , docEmpty , docLit @@ -64,6 +65,8 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , hasAnyCommentsBelow , hasAnyCommentsConnected , hasAnyCommentsPrior + , hasAnyRegularCommentsConnected + , hasAnyRegularCommentsRest , hasAnnKeywordComment , hasAnnKeyword ) @@ -263,9 +266,13 @@ askIndent = confUnpack . _lconfig_indentAmount . _conf_layout <$> mAsk extractAllComments :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)] extractAllComments ann = - ExactPrint.annPriorComments ann - ++ ExactPrint.annFollowingComments ann - ++ ( ExactPrint.annsDP ann >>= \case + ExactPrint.annPriorComments ann ++ extractRestComments ann + +extractRestComments + :: ExactPrint.Annotation -> [(ExactPrint.Comment, ExactPrint.DeltaPos)] +extractRestComments ann = + ExactPrint.annFollowingComments ann + ++ (ExactPrint.annsDP ann >>= \case (ExactPrint.AnnComment com, dp) -> [(com, dp)] _ -> [] ) @@ -278,31 +285,40 @@ filterAnns ast = -- a) connected to any node below (in AST sense) the given node AND -- b) after (in source code order) the node. hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool -hasAnyCommentsBelow ast@(L l _) = do - anns <- filterAnns ast <$> mAsk - return - $ List.any (\(c, _) -> ExactPrint.commentIdentifier c > l) - $ (=<<) extractAllComments - $ Map.elems - $ anns +hasAnyCommentsBelow ast@(L l _) = + List.any (\(c, _) -> ExactPrint.commentIdentifier c > l) + <$> astConnectedComments ast --- | True if there are any comments that are --- connected to any node below (in AST sense) the given node +-- | True if there are any comments that are connected to any node below (in AST +-- sense) the given node hasAnyCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool -hasAnyCommentsConnected ast = do +hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast + +-- | True if there are any regular comments connected to any node below (in AST +-- sense) the given node +hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool +hasAnyRegularCommentsConnected ast = any isRegular <$> astConnectedComments ast + where isRegular = (== Nothing) . ExactPrint.Types.commentOrigin . fst + +astConnectedComments + :: Data ast + => GHC.Located ast + -> ToBriDocM [(ExactPrint.Types.Comment, ExactPrint.Types.DeltaPos)] +astConnectedComments ast = do anns <- filterAnns ast <$> mAsk - return - $ not - $ null - $ (=<<) extractAllComments - $ Map.elems - $ anns + pure $ extractAllComments =<< Map.elems anns hasAnyCommentsPrior :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyCommentsPrior ast = astAnn ast <&> \case Nothing -> False Just (ExactPrint.Types.Ann _ priors _ _ _ _) -> not $ null priors +hasAnyRegularCommentsRest :: Data ast => GHC.Located ast -> ToBriDocM Bool +hasAnyRegularCommentsRest ast = astAnn ast <&> \case + Nothing -> False + Just ann -> any isRegular (extractRestComments ann) + where isRegular = (== Nothing) . ExactPrint.Types.commentOrigin . fst + hasAnnKeywordComment :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool hasAnnKeywordComment ast annKeyword = astAnn ast <&> \case diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 37724f6..ec3f06f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -33,6 +33,9 @@ import GHC ( runGhc ) import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc ) import HsSyn +#if MIN_VERSION_ghc(8,6,0) +import HsExtension (NoExt (..)) +#endif import Name import BasicTypes ( InlinePragma(..) , Activation(..) @@ -62,7 +65,8 @@ layoutDecl d@(L loc decl) = case decl of Left ns -> docLines $ return <$> ns Right n -> return n TyClD _ tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) - InstD _ (TyFamInstD{}) -> layoutTyFamInstDWorkaround d + InstD _ (TyFamInstD _ tfid) -> + withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid) InstD _ (ClsInstD _ inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) _ -> briDocByExactNoComment d @@ -73,25 +77,12 @@ layoutDecl d@(L loc decl) = case decl of Left ns -> docLines $ return <$> ns Right n -> return n TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) - InstD (TyFamInstD{}) -> layoutTyFamInstDWorkaround d + InstD (TyFamInstD tfid) -> + withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid) InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) _ -> briDocByExactNoComment d #endif -layoutTyFamInstDWorkaround :: ToBriDoc HsDecl -layoutTyFamInstDWorkaround d = do - -- this is a (temporary (..)) workaround for "type instance" decls - -- that do not round-trip through exactprint properly. - let fixer s = case List.stripPrefix "type " s of - Just rest | not ("instance" `isPrefixOf` rest) -> - "type instance " ++ rest - _ -> s - str <- mAsk <&> \anns -> - intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns - allocateNode $ BDFExternal (ExactPrint.mkAnnKey d) - (foldedAnnKeys d) - False - (Text.pack str) -------------------------------------------------------------------------------- -- Sig @@ -156,24 +147,11 @@ layoutSig lsig@(L _loc sig) = case sig of ] ] ] - else - docAlt - $ [ docSeq - [ appSep $ docWrapNodeRest lsig $ docLit nameStr - , appSep $ docLit $ Text.pack "::" - , docForceSingleline typeDoc - ] - | not hasComments - ] - ++ [ docAddBaseY BrIndentRegular $ docPar - (docWrapNodeRest lsig $ docLit nameStr) - ( docCols - ColTyOpPrefix - [ docLit $ Text.pack ":: " - , docAddBaseY (BrIndentSpecial 3) $ typeDoc - ] - ) - ] + else layoutLhsAndType + hasComments + (appSep . docWrapNodeRest lsig $ docLit nameStr) + "::" + typeDoc specStringCompat :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String @@ -754,12 +732,7 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do sharedLhs <- docSharedWrapper id lhs typeDoc <- docSharedWrapper layoutType typ hasComments <- hasAnyCommentsConnected typ - runFilteredAlternative $ do - addAlternativeCond (not hasComments) $ docSeq - [sharedLhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc] - addAlternative $ docAddBaseY BrIndentRegular $ docPar - sharedLhs - (docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc]) + layoutLhsAndType hasComments sharedLhs "=" typeDoc layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr layoutTyVarBndr needsSep lbndr@(L _ bndr) = do @@ -788,6 +761,55 @@ layoutTyVarBndr needsSep lbndr@(L _ bndr) = do ] +-------------------------------------------------------------------------------- +-- TyFamInstDecl +-------------------------------------------------------------------------------- + +layoutTyFamInstDecl :: Bool -> ToBriDoc TyFamInstDecl +layoutTyFamInstDecl inClass (L loc tfid) = do + let +#if MIN_VERSION_ghc(8,6,0) + linst = L loc (TyFamInstD NoExt tfid) + feqn@(FamEqn _ name pats _fixity typ) = hsib_body $ tfid_eqn tfid + lfeqn = L loc feqn +#elif MIN_VERSION_ghc(8,4,0) + linst = L loc (TyFamInstD tfid) + feqn@(FamEqn name pats _fixity typ) = hsib_body $ tfid_eqn tfid + lfeqn = L loc feqn +#elif MIN_VERSION_ghc(8,2,0) + linst = L loc (TyFamInstD tfid) + lfeqn@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid + pats = hsib_body boundPats +#else + linst = L loc (TyFamInstD tfid) + lfeqn@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid + pats = hsib_body boundPats +#endif + docWrapNodePrior linst $ do + nameStr <- lrdrNameToTextAnn name + needsParens <- hasAnnKeyword lfeqn AnnOpenP + let + instanceDoc = if inClass + then docLit $ Text.pack "type" + else docSeq + [appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"] + lhs = + docWrapNode lfeqn + . appSep + . docWrapNodeRest linst + . docSeq + $ (appSep instanceDoc :) + $ [ docParenL | needsParens ] + ++ [appSep $ docWrapNode name $ docLit nameStr] + ++ intersperse docSeparator (layoutType <$> pats) + ++ [ docParenR | needsParens ] + hasComments <- (||) + <$> hasAnyRegularCommentsConnected lfeqn + <*> hasAnyRegularCommentsRest linst + typeDoc <- docSharedWrapper layoutType typ + layoutLhsAndType hasComments lhs "=" typeDoc + + -------------------------------------------------------------------------------- -- ClsInstDecl -------------------------------------------------------------------------------- @@ -855,12 +877,7 @@ layoutClsInst lcid@(L _ cid) = docLines layoutAndLocateTyFamInsts :: ToBriDocC (TyFamInstDecl GhcPs) (Located BriDocNumbered) layoutAndLocateTyFamInsts ltfid@(L loc _) = - L loc <$> layoutTyFamInstDecl ltfid - - -- | Send to ExactPrint then remove unecessary whitespace - layoutTyFamInstDecl :: ToBriDoc TyFamInstDecl - layoutTyFamInstDecl ltfid = - fmap stripWhitespace <$> briDocByExactNoComment ltfid + L loc <$> layoutTyFamInstDecl True ltfid layoutAndLocateDataFamInsts :: ToBriDocC (DataFamInstDecl GhcPs) (Located BriDocNumbered) @@ -928,3 +945,23 @@ layoutClsInst lcid@(L _ cid) = docLines isTypeOrData t' = (Text.pack "type" `Text.isPrefixOf` t') || (Text.pack "data" `Text.isPrefixOf` t') + + +-------------------------------------------------------------------------------- +-- Common Helpers +-------------------------------------------------------------------------------- + +layoutLhsAndType + :: Bool + -> ToBriDocM BriDocNumbered + -> String + -> ToBriDocM BriDocNumbered + -> ToBriDocM BriDocNumbered +layoutLhsAndType hasComments lhs sep typeDoc = do + let sepDoc = appSep . docLit $ Text.pack sep + runFilteredAlternative $ do + addAlternativeCond (not hasComments) + $ docSeq [lhs, sepDoc, docForceSingleline typeDoc] + addAlternative $ docAddBaseY BrIndentRegular $ docPar lhs $ docCols + ColTyOpPrefix + [sepDoc, docAddBaseY (BrIndentSpecial (length sep + 1)) typeDoc] From f68fbb3118aabaa961e24530f0105fc95578a0b5 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 26 Jan 2019 10:55:29 -0800 Subject: [PATCH 02/11] Add build instructions for nix --- .gitignore | 1 + README.md | 6 ++++++ default.nix | 13 +++++++++++++ pkgs.nix | 5 +++++ 4 files changed, 25 insertions(+) create mode 100644 default.nix create mode 100644 pkgs.nix diff --git a/.gitignore b/.gitignore index 906e747..4393459 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ local/ cabal.sandbox.config cabal.project.local .ghc.environment.* +result \ No newline at end of file diff --git a/README.md b/README.md index d42d085..da9675b 100644 --- a/README.md +++ b/README.md @@ -94,6 +94,12 @@ log the size of the input, but _not_ the full input/output of requests.) aura -A brittany ~~~~ +- via `nix`: + ~~~.sh + nix build # or 'nix-build' + nix-env -i ./result + ~~~ + # Editor Integration #### Sublime text diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..5c0ccfe --- /dev/null +++ b/default.nix @@ -0,0 +1,13 @@ +{ pkgs ? import (fetchGit (import ./pkgs.nix)) {} +, compiler ? "ghc822" +}: + +pkgs.haskell.packages.${compiler}.developPackage { + root = ./.; + name = "brittany"; + overrides = with pkgs.haskell.lib; self: super: { + }; + source-overrides = { + ghc-exactprint = "0.5.8.0"; + }; +} diff --git a/pkgs.nix b/pkgs.nix new file mode 100644 index 0000000..76cbbb8 --- /dev/null +++ b/pkgs.nix @@ -0,0 +1,5 @@ +{ + url = "https://github.com/nixos/nixpkgs.git"; + ref = "release-18.09"; + rev = "b9fa31cea0e119ecf1867af4944ddc2f7633aacd"; +} From e67a46f2649ee53380f2a7d933588e8587ba0ecd Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 29 Jan 2019 14:01:29 -0800 Subject: [PATCH 03/11] Refactor nix expressions This way, the default.nix file can be imported to other projects. In order to build brittany, we now need to do `nix build -f release.nix`, which will pull in the version overrides from shell.nix. --- README.md | 2 +- default.nix | 47 ++++++++++++++++++++++++++++++++++++----------- release.nix | 5 +++++ shell.nix | 13 +++++++++++++ 4 files changed, 55 insertions(+), 12 deletions(-) create mode 100644 release.nix create mode 100644 shell.nix diff --git a/README.md b/README.md index da9675b..672de96 100644 --- a/README.md +++ b/README.md @@ -96,7 +96,7 @@ log the size of the input, but _not_ the full input/output of requests.) - via `nix`: ~~~.sh - nix build # or 'nix-build' + nix build -f release.nix # or 'nix-build -f release.nix' nix-env -i ./result ~~~ diff --git a/default.nix b/default.nix index 5c0ccfe..296987a 100644 --- a/default.nix +++ b/default.nix @@ -1,13 +1,38 @@ -{ pkgs ? import (fetchGit (import ./pkgs.nix)) {} -, compiler ? "ghc822" +{ mkDerivation, aeson, base, butcher, bytestring, cmdargs +, containers, czipwith, data-tree-print, deepseq, directory, extra +, filepath, ghc, ghc-boot-th, ghc-exactprint, ghc-paths, hspec +, monad-memo, mtl, multistate, neat-interpolation, parsec, pretty +, random, safe, semigroups, stdenv, strict, syb, text, transformers +, uniplate, unsafe, yaml }: - -pkgs.haskell.packages.${compiler}.developPackage { - root = ./.; - name = "brittany"; - overrides = with pkgs.haskell.lib; self: super: { - }; - source-overrides = { - ghc-exactprint = "0.5.8.0"; - }; +mkDerivation { + pname = "brittany"; + version = "0.11.0.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + aeson base butcher bytestring cmdargs containers czipwith + data-tree-print deepseq directory extra filepath ghc ghc-boot-th + ghc-exactprint ghc-paths monad-memo mtl multistate + neat-interpolation pretty random safe semigroups strict syb text + transformers uniplate unsafe yaml + ]; + executableHaskellDepends = [ + aeson base butcher bytestring cmdargs containers czipwith + data-tree-print deepseq directory extra filepath ghc ghc-boot-th + ghc-exactprint ghc-paths monad-memo mtl multistate + neat-interpolation pretty safe semigroups strict syb text + transformers uniplate unsafe yaml + ]; + testHaskellDepends = [ + aeson base butcher bytestring cmdargs containers czipwith + data-tree-print deepseq directory extra filepath ghc ghc-boot-th + ghc-exactprint ghc-paths hspec monad-memo mtl multistate + neat-interpolation parsec pretty safe semigroups strict syb text + transformers uniplate unsafe yaml + ]; + homepage = "https://github.com/lspitzner/brittany/"; + description = "Haskell source code formatter"; + license = stdenv.lib.licenses.agpl3; } diff --git a/release.nix b/release.nix new file mode 100644 index 0000000..b37b2ce --- /dev/null +++ b/release.nix @@ -0,0 +1,5 @@ +{ pkgs ? import (fetchGit (import ./pkgs.nix)) {} +, compiler ? "ghc822" +}: + +pkgs.haskell.packages.${compiler}.callPackage ./shell.nix {} diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..5c0ccfe --- /dev/null +++ b/shell.nix @@ -0,0 +1,13 @@ +{ pkgs ? import (fetchGit (import ./pkgs.nix)) {} +, compiler ? "ghc822" +}: + +pkgs.haskell.packages.${compiler}.developPackage { + root = ./.; + name = "brittany"; + overrides = with pkgs.haskell.lib; self: super: { + }; + source-overrides = { + ghc-exactprint = "0.5.8.0"; + }; +} From 6aa537089d6e93c8080ef0c009801cfa2b303e8c Mon Sep 17 00:00:00 2001 From: Matt Noonan Date: Mon, 4 Feb 2019 15:10:55 -0500 Subject: [PATCH 04/11] Disable single-line HsApp with argument comments. --- src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index caf51a7..dd0639d 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -172,9 +172,10 @@ layoutExpr lexpr@(L _ expr) = do _ -> docSeq headDoc <- docSharedWrapper layoutExpr headE paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs + hasComments <- hasAnyCommentsConnected exp2 runFilteredAlternative $ do -- foo x y - addAlternative + addAlternativeCond (not hasComments) $ colsOrSequence $ appSep (docForceSingleline headDoc) : spacifyDocs (docForceSingleline <$> paramDocs) From 855160037736898712021d039a29bf8bc9d3ed13 Mon Sep 17 00:00:00 2001 From: Matt Noonan Date: Mon, 4 Feb 2019 22:56:46 -0500 Subject: [PATCH 05/11] Explicitly handle empty HsCase and HsLamCase. --- .../Brittany/Internal/Layouters/Expr.hs | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index caf51a7..0982308 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -136,6 +136,15 @@ layoutExpr lexpr@(L _ expr) = do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ XMatchGroup{} -> error "brittany internal error: HsLamCase XMatchGroup" + HsLamCase _ (MG _ (L _ []) _) -> do +#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/ + HsLamCase (MG (L _ []) _ _ _) -> do +#else /* ghc-8.0 */ + HsLamCase _ (MG (L _ []) _ _ _) -> do +#endif + docSetParSpacing $ docAddBaseY BrIndentRegular $ + (docLit $ Text.pack "\\case {}") +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do #elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/ HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do @@ -520,6 +529,19 @@ layoutExpr lexpr@(L _ expr) = do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ _ XMatchGroup{} -> error "brittany internal error: HsCase XMatchGroup" + HsCase _ cExp (MG _ (L _ []) _) -> do +#else + HsCase cExp (MG (L _ []) _ _ _) -> do +#endif + cExpDoc <- docSharedWrapper layoutExpr cExp + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docSeq + [ appSep $ docLit $ Text.pack "case" + , appSep $ docForceSingleline cExpDoc + , docLit $ Text.pack "of {}" + ] +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do #else HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do From ff7dca9bb55599afe0f76fc2d090e28aa28752bb Mon Sep 17 00:00:00 2001 From: Artem Chernyak Date: Tue, 12 Mar 2019 21:29:12 -0500 Subject: [PATCH 06/11] Added Emacs to Editor Integration --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index d42d085..9383323 100644 --- a/README.md +++ b/README.md @@ -111,6 +111,8 @@ log the size of the input, but _not_ the full input/output of requests.) brittany built in. #### Atom [Atom Beautify](https://atom.io/packages/atom-beautify) supports brittany as a formatter for Haskell. Since the default formatter is set to hindent, you will need to change this setting to brittany, after installing the extension. +#### Emacs + [format-all](https://github.com/lassik/emacs-format-all-the-code) support brittany as the default formatter for Haskell. # Usage From d161648f24705da914b6a09663d2554c0323c34c Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 2 Jun 2019 22:53:00 +0200 Subject: [PATCH 07/11] Allow ghc-exactprint-0.6.1 --- brittany.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/brittany.cabal b/brittany.cabal index c1a31eb..95f454b 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -86,7 +86,7 @@ library { { base >=4.9 && <4.13 , ghc >=8.0.1 && <8.7 , ghc-paths >=0.1.0.9 && <0.2 - , ghc-exactprint >=0.5.8 && <0.5.9 + , ghc-exactprint >=0.5.8 && <0.6.2 , transformers >=0.5.2.0 && <0.6 , containers >=0.5.7.1 && <0.7 , mtl >=2.2.1 && <2.3 From bd8b743e3645f2e8a4611aa08761b1319b3aeea0 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 5 Jun 2019 15:42:47 +0200 Subject: [PATCH 08/11] Document terminology "regular comments" --- .../Brittany/Internal/LayouterBasics.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 977e8e8..701339c 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -297,8 +297,20 @@ hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast -- | True if there are any regular comments connected to any node below (in AST -- sense) the given node hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool -hasAnyRegularCommentsConnected ast = any isRegular <$> astConnectedComments ast - where isRegular = (== Nothing) . ExactPrint.Types.commentOrigin . fst +hasAnyRegularCommentsConnected ast = + any isRegularComment <$> astConnectedComments ast + +-- | Regular comments are comments that are actually "source code comments", +-- i.e. things that start with "--" or "{-". In contrast to comment-annotations +-- used by ghc-exactprint for capturing symbols (and their exact positioning). +-- +-- Only the type instance layouter makes use of this filter currently, but +-- it might make sense to apply it more aggressively or make it the default - +-- I believe that most of the time we branch on the existence of comments, we +-- only care about "regular" comments. We simply did not need the distinction +-- because "irregular" comments are not that common outside of type/data decls. +isRegularComment :: (ExactPrint.Comment, ExactPrint.DeltaPos) -> Bool +isRegularComment = (== Nothing) . ExactPrint.Types.commentOrigin . fst astConnectedComments :: Data ast @@ -316,8 +328,7 @@ hasAnyCommentsPrior ast = astAnn ast <&> \case hasAnyRegularCommentsRest :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyRegularCommentsRest ast = astAnn ast <&> \case Nothing -> False - Just ann -> any isRegular (extractRestComments ann) - where isRegular = (== Nothing) . ExactPrint.Types.commentOrigin . fst + Just ann -> any isRegularComment (extractRestComments ann) hasAnnKeywordComment :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool From ca3c8b6f9eada12dd3747460b3536e0d95c9d627 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 5 Jun 2019 15:56:32 +0200 Subject: [PATCH 09/11] Add one source doc --- src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index ec3f06f..9366a6f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -960,8 +960,17 @@ layoutLhsAndType layoutLhsAndType hasComments lhs sep typeDoc = do let sepDoc = appSep . docLit $ Text.pack sep runFilteredAlternative $ do + -- (separators probably are "=" or "::") + -- lhs = type + -- lhs :: type addAlternativeCond (not hasComments) $ docSeq [lhs, sepDoc, docForceSingleline typeDoc] + -- lhs + -- :: typeA + -- -> typeB + -- lhs + -- = typeA + -- -> typeB addAlternative $ docAddBaseY BrIndentRegular $ docPar lhs $ docCols ColTyOpPrefix [sepDoc, docAddBaseY (BrIndentSpecial (length sep + 1)) typeDoc] From 09a227fcce36afd3029697e43471b1b9f0390da4 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 5 Jun 2019 20:11:01 +0200 Subject: [PATCH 10/11] Add quick regression-test for fixed issue --- src-literatetests/15-regressions.blt | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index 080c15e..d402ca7 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -650,3 +650,13 @@ jaicyhHumzo btrKpeyiFej mava = do ) Xcde{} -> (s, Pioemav) pure imomue + +#test issue 214 +-- brittany { lconfig_indentPolicy: IndentPolicyMultiple } +foo = bar + arg1 -- this is the first argument + arg2 -- this is the second argument + arg3 -- this is the third argument, now I'll skip one comment + arg4 + arg5 -- this is the fifth argument + arg6 -- this is the sixth argument From f9d70cf546d3c3f22a74ddba052da08272667561 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 5 Jun 2019 20:11:01 +0200 Subject: [PATCH 11/11] Refactor CPP slightly, Add test-cases --- src-literatetests/10-tests.blt | 39 +++++++++++++++++++ .../Brittany/Internal/Layouters/Expr.hs | 14 ++++++- 2 files changed, 51 insertions(+), 2 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 4d274c7..5b6e0f5 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -531,6 +531,45 @@ func = if cond -- test abc +#test nonempty-case-short +func = case x of + False -> False + True -> True + +#test nonempty-case-long +func = + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of + False -> False + True -> True + +#test nonempty-case-long-do +func = do + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of + False -> False + True -> True + +#test empty-case-short +func = case x of {} + +#test empty-case-long +func = + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of {} + +#test empty-case-long-do +func = do + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of {} ############################################################################### ############################################################################### diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 0982308..94c4183 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -136,6 +136,8 @@ layoutExpr lexpr@(L _ expr) = do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ XMatchGroup{} -> error "brittany internal error: HsLamCase XMatchGroup" +#endif +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsLamCase _ (MG _ (L _ []) _) -> do #elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/ HsLamCase (MG (L _ []) _ _ _) -> do @@ -529,18 +531,26 @@ layoutExpr lexpr@(L _ expr) = do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ _ XMatchGroup{} -> error "brittany internal error: HsCase XMatchGroup" +#endif +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ cExp (MG _ (L _ []) _) -> do #else HsCase cExp (MG (L _ []) _ _ _) -> do #endif cExpDoc <- docSharedWrapper layoutExpr cExp - docSetParSpacing - $ docAddBaseY BrIndentRegular + docAlt + [ docAddBaseY BrIndentRegular $ docSeq [ appSep $ docLit $ Text.pack "case" , appSep $ docForceSingleline cExpDoc , docLit $ Text.pack "of {}" ] + , docPar + ( docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "case") cExpDoc + ) + (docLit $ Text.pack "of {}") + ] #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do #else