From 71efa549540ee085b7abe49a73b5dd95b97b3a4e Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sun, 23 Sep 2018 23:09:50 +0200 Subject: [PATCH] Move tests, minor Refactoring, Add comments --- src-literatetests/14-extensions.blt | 14 +++++++++++ src-literatetests/15-regressions.blt | 12 --------- .../Brittany/Internal/LayouterBasics.hs | 18 ++++++++----- .../Brittany/Internal/Layouters/Expr.hs | 2 +- .../Brittany/Internal/Layouters/Pattern.hs | 2 +- .../Brittany/Internal/Layouters/Type.hs | 25 +++++++++---------- 6 files changed, 40 insertions(+), 33 deletions(-) diff --git a/src-literatetests/14-extensions.blt b/src-literatetests/14-extensions.blt index 0e71918..9dc0378 100644 --- a/src-literatetests/14-extensions.blt +++ b/src-literatetests/14-extensions.blt @@ -81,3 +81,17 @@ import Test ( type (++) , pattern Foo , pattern (:.) ) + +############################################################################### +## UnboxedTuples + MagicHash +#test unboxed-tuple and vanilla names +{-# LANGUAGE UnboxedTuples #-} +spanKey :: (# Int, Int #) -> (# Int, Int #) +spanKey = case foo of + (# bar, baz #) -> (# baz, bar #) + +#test unboxed-tuple and hashed name +{-# LANGUAGE MagicHash, UnboxedTuples #-} +spanKey :: (# Int#, Int# #) -> (# Int#, Int# #) +spanKey = case foo of + (# bar#, baz# #) -> (# baz# +# bar#, bar# #) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index e7bf199..080c15e 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -650,15 +650,3 @@ jaicyhHumzo btrKpeyiFej mava = do ) Xcde{} -> (s, Pioemav) pure imomue - -#test unboxed-tuple and vanilla names -{-# LANGUAGE UnboxedTuples #-} -spanKey :: (# Int, Int #) -> (# Int, Int #) -spanKey = case foo of - (# bar, baz #) -> (# baz, bar #) - -#test unboxed-tuple and hashed name -{-# LANGUAGE MagicHash, UnboxedTuples #-} -spanKey :: (# Int#, Int# #) -> (# Int#, Int# #) -spanKey = case foo of - (# bar#, baz# #) -> (# baz# +# bar#, bar# #) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index c6cd9ae..a431855 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -52,8 +52,8 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , docParenLSep , docParenL , docParenR - , docParenHashL - , docParenHashR + , docParenHashLSep + , docParenHashRSep , docBracketL , docBracketR , docTick @@ -537,17 +537,23 @@ docCommaSep = appSep $ docLit $ Text.pack "," docParenLSep :: ToBriDocM BriDocNumbered docParenLSep = appSep docParenL +-- TODO: we don't make consistent use of these (yet). However, I think the +-- most readable approach overall might be something else: define +-- `lit = docLit . Text.pack` and `prepSep = docSeq [docSeparator, x]`. +-- I think those two would make the usage most readable. +-- lit "(" and appSep (lit "(") are understandable and short without +-- introducing a new top-level binding for all types of parentheses. docParenL :: ToBriDocM BriDocNumbered docParenL = docLit $ Text.pack "(" docParenR :: ToBriDocM BriDocNumbered docParenR = docLit $ Text.pack ")" -docParenHashL :: ToBriDocM BriDocNumbered -docParenHashL = docSeq [docLit $ Text.pack "(#", docSeparator] +docParenHashLSep :: ToBriDocM BriDocNumbered +docParenHashLSep = docSeq [docLit $ Text.pack "(#", docSeparator] -docParenHashR :: ToBriDocM BriDocNumbered -docParenHashR = docSeq [docSeparator, docLit $ Text.pack "#)"] +docParenHashRSep :: ToBriDocM BriDocNumbered +docParenHashRSep = docSeq [docSeparator, docLit $ Text.pack "#)"] docBracketL :: ToBriDocM BriDocNumbered docBracketL = docLit $ Text.pack "[" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index a486d3b..1da80ae 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -372,7 +372,7 @@ layoutExpr lexpr@(L _ expr) = do hasComments <- hasAnyCommentsBelow lexpr let (openLit, closeLit) = case boxity of Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") - Unboxed -> (docParenHashL, docParenHashR) + Unboxed -> (docParenHashLSep, docParenHashRSep) case splitFirstLast argDocs of FirstLastEmpty -> docSeq [ openLit diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index 6b8e750..f409c30 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -141,7 +141,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr case boxity of Boxed -> wrapPatListy args "()" docParenL docParenR - Unboxed -> wrapPatListy args "(##)" docParenHashL docParenHashR + Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep AsPat asName asPat -> do -- bind@nestedpat -> expr wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index d50a10c..5e97d5b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -392,33 +392,32 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of unitL = docLit $ Text.pack "()" simpleL = do docs <- docSharedWrapper layoutType `mapM` typs + let end = docLit $ Text.pack ")" + lines = List.tail docs <&> \d -> + docCols ColTyOpPrefix [docCommaSep, d] docAlt [ docSeq $ [docLit $ Text.pack "("] ++ List.intersperse docCommaSep (docForceSingleline <$> docs) - ++ [docLit $ Text.pack ")"] - , let - start = docCols ColTyOpPrefix [docParenLSep, head docs] - lines = List.tail docs <&> \d -> - docCols ColTyOpPrefix [docCommaSep, d] - end = docLit $ Text.pack ")" + ++ [end] + , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs] in docPar - (docAddBaseY (BrIndentSpecial 2) $ start) + (docAddBaseY (BrIndentSpecial 2) $ line1) (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end]) ] unboxedL = do docs <- docSharedWrapper layoutType `mapM` typs - let start = docParenHashL - end = docParenHashR + let start = docParenHashLSep + end = docParenHashRSep docAlt [ docSeq $ [start] - ++ List.intersperse docCommaSep docs - ++ [end] + ++ List.intersperse docCommaSep docs + ++ [end] , let - start' = docCols ColTyOpPrefix [start, head docs] + line1 = docCols ColTyOpPrefix [start, head docs] lines = List.tail docs <&> \d -> docCols ColTyOpPrefix [docCommaSep, d] in docPar - (docAddBaseY (BrIndentSpecial 2) start') + (docAddBaseY (BrIndentSpecial 2) line1) (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end]) ] HsOpTy{} -> -- TODO