From ca13a1897f2aa3827b9262c89a05b3f83acf1b54 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 20 Aug 2017 13:14:54 +0200
Subject: [PATCH] Fix type application layouting (fixes #48)
- one-line externals are not detected as multiline in backend
- layouting of EAsPat (when TypeApplications is disabled)
- layouting of HsTyLit (TypeApplications with literals)
---
src-literatetests/tests.blt | 18 +++++++++++++++++-
.../Haskell/Brittany/Internal/Backend.hs | 1 +
.../Brittany/Internal/Layouters/Expr.hs | 8 +++++---
.../Brittany/Internal/Layouters/Type.hs | 15 +++++++++++++--
4 files changed, 36 insertions(+), 6 deletions(-)
diff --git a/src-literatetests/tests.blt b/src-literatetests/tests.blt
index 2566e06..e54841b 100644
--- a/src-literatetests/tests.blt
+++ b/src-literatetests/tests.blt
@@ -956,6 +956,7 @@ runBrittany tabSize text = do
foo = bar @Baz
#test comment-before-BDCols
+{-# LANGUAGE TypeApplications #-}
layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
docAlt
$ -- one-line solution
@@ -972,7 +973,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
, [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
, wherePart <- case mWhereDocs of
- Nothing -> return @[] $ docEmpty
+ Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
@@ -1026,6 +1027,21 @@ foo n = case n of
bar n = case n of
(-2, -2) -> (-2, -2)
+#test issue 48 a
+
+foo =
+ let a = b@1
+ cccc = ()
+ in foo
+
+#test issue 48 b
+
+{-# LANGUAGE TypeApplications #-}
+foo =
+ let a = b @1
+ cccc = ()
+ in foo
+
###############################################################################
###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs
index fd00c23..44264d4 100644
--- a/src/Language/Haskell/Brittany/Internal/Backend.hs
+++ b/src/Language/Haskell/Brittany/Internal/Backend.hs
@@ -312,6 +312,7 @@ briDocIsMultiLine briDoc = rec briDoc
BDForceMultiline _ -> True
BDForceSingleline bd -> rec bd
BDForwardLineMode bd -> rec bd
+ BDExternal _ _ _ t | [_] <- Text.lines t -> False
BDExternal _ _ _ _ -> True
BDAnnotationPrior _ bd -> rec bd
BDAnnotationKW _ _ bd -> rec bd
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
index 253d475..a6ba345 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
@@ -902,9 +902,11 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
briDocByExactInlineOnly "HsTickPragma{}" lexpr
EWildPat{} -> do
docLit $ Text.pack "_"
- EAsPat{} -> do
- -- TODO
- briDocByExactInlineOnly "EAsPat{}" lexpr
+ EAsPat asName asExpr -> do
+ docSeq
+ [ docLit $ (lrdrNameToText asName) <> Text.pack "@"
+ , layoutExpr asExpr
+ ]
EViewPat{} -> do
-- TODO
briDocByExactInlineOnly "EViewPat{}" lexpr
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index f72594c..36d1633 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -19,6 +19,7 @@ import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
import HsSyn
import Name
import Outputable ( ftext, showSDocUnsafe )
+import BasicTypes
import DataTreePrint
@@ -599,8 +600,18 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
HsExplicitTupleTy{} -> -- TODO
briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype
- HsTyLit{} -> -- TODO
- briDocByExactInlineOnly "HsTyLit{}" ltype
+ HsTyLit lit -> case lit of
+#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+ HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
+ HsNumTy NoSourceText _ ->
+ error "overLitValBriDoc: literal with no SourceText"
+ HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext
+ HsStrTy NoSourceText _ ->
+ error "overLitValBriDoc: literal with no SourceText"
+#else /* ghc-8.0 */
+ HsNumTy srctext _ -> docLit $ Text.pack srctext
+ HsStrTy srctext _ -> docLit $ Text.pack srctext
+#endif
HsCoreTy{} -> -- TODO
briDocByExactInlineOnly "HsCoreTy{}" ltype
HsWildCardTy _ ->