diff --git a/.travis.yml b/.travis.yml index 675395a..a67ec03 100644 --- a/.travis.yml +++ b/.travis.yml @@ -292,7 +292,7 @@ script: canew) better_wait cabal new-build -j$JOBS --ghc-options="-j1 +RTS -M500M -RTS" --disable-tests --disable-benchmarks better_wait cabal new-build -j$JOBS --ghc-options="-j1 +RTS -M500M -RTS" --enable-tests --enable-benchmarks - cabal new-test --ghc-options="-j1 +RTS -M500M -RTS" + cabal new-test -j1 --ghc-options="-j1 +RTS -M500M -RTS" ;; esac set +ex diff --git a/brittany.cabal b/brittany.cabal index 332ca76..4d43fcc 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -335,8 +335,9 @@ test-suite littests ghc-options: { -Wall -fno-warn-unused-imports + -threaded -rtsopts - -with-rtsopts "-M2G" + -with-rtsopts "-M2G -N" } test-suite libinterfacetests 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/Main.hs b/src-literatetests/Main.hs index 8f492d1..1196a56 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -1,12 +1,13 @@ {-# LANGUAGE QuasiQuotes #-} -module Main where +module Main (main) where #include "prelude.inc" import Test.Hspec +import Test.Hspec.Runner ( hspecWith, defaultConfig, configConcurrentJobs ) import NeatInterpolation @@ -22,6 +23,7 @@ import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config import Data.Coerce ( coerce ) +import GHC.Conc ( getNumCapabilities ) import qualified Data.Text.IO as Text.IO import System.FilePath ( () ) @@ -48,7 +50,8 @@ main = do let groups = createChunks =<< inputs inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt" let groupsCtxFree = createChunks inputCtxFree - hspec $ do + jobs <- getNumCapabilities + hspecWith (defaultConfig { configConcurrentJobs = Just jobs }) $ do groups `forM_` \(groupname, tests) -> do describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do (if pend then before_ pending else id) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index d5aac63..a431855 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -50,7 +50,12 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , appSep , docCommaSep , docParenLSep + , docParenL , docParenR + , docParenHashLSep + , docParenHashRSep + , docBracketL + , docBracketR , docTick , spacifyDocs , briDocMToPPM @@ -530,11 +535,33 @@ docCommaSep :: ToBriDocM BriDocNumbered docCommaSep = appSep $ docLit $ Text.pack "," docParenLSep :: ToBriDocM BriDocNumbered -docParenLSep = appSep $ docLit $ Text.pack "(" +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 ")" +docParenHashLSep :: ToBriDocM BriDocNumbered +docParenHashLSep = docSeq [docLit $ Text.pack "(#", docSeparator] + +docParenHashRSep :: ToBriDocM BriDocNumbered +docParenHashRSep = docSeq [docSeparator, docLit $ Text.pack "#)"] + +docBracketL :: ToBriDocM BriDocNumbered +docBracketL = docLit $ Text.pack "[" + +docBracketR :: ToBriDocM BriDocNumbered +docBracketR = docLit $ Text.pack "]" + + docTick :: ToBriDocM BriDocNumbered docTick = docLit $ Text.pack "'" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 92bcceb..1da80ae 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -371,8 +371,8 @@ layoutExpr lexpr@(L _ expr) = do $ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM hasComments <- hasAnyCommentsBelow lexpr let (openLit, closeLit) = case boxity of - Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") - Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)") + Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") + 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 c65b357..f409c30 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -140,8 +140,8 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of -- (nestedpat1, nestedpat2, nestedpat3) -> expr -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr case boxity of - Boxed -> wrapPatListy args "(" ")" - Unboxed -> wrapPatListy args "(#" "#)" + Boxed -> wrapPatListy args "()" docParenL docParenR + Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep AsPat asName asPat -> do -- bind@nestedpat -> expr wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") @@ -172,7 +172,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of ListPat elems _ _ -> -- [] -> expr1 -- [nestedpat1, nestedpat2, nestedpat3] -> expr2 - wrapPatListy elems "[" "]" + wrapPatListy elems "[]" docBracketL docBracketR BangPat pat1 -> do -- !nestedpat -> expr wrapPatPrepend pat1 (docLit $ Text.pack "!") @@ -212,18 +212,18 @@ wrapPatPrepend pat prepElem = do wrapPatListy :: [Located (Pat GhcPs)] -> String - -> String + -> ToBriDocM BriDocNumbered + -> ToBriDocM BriDocNumbered -> ToBriDocM (Seq BriDocNumbered) -wrapPatListy elems start end = do +wrapPatListy elems both start end = do elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat) - sDoc <- docLit $ Text.pack start - eDoc <- docLit $ Text.pack end case Seq.viewl elemDocs of - Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack $ start ++ end + Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack both x1 Seq.:< rest -> do - rest' <- rest `forM` \bd -> docSeq - [ docLit $ Text.pack "," - , docSeparator - , return bd - ] - return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc + sDoc <- start + eDoc <- end + rest' <- rest `forM` \bd -> docSeq + [ docCommaSep + , return bd + ] + return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index dfde7f5..5e97d5b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -234,7 +234,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of list = List.tail cntxtDocs <&> \cntxtDoc -> docCols ColTyOpPrefix [ docCommaSep - , docAddBaseY (BrIndentSpecial 2) + , docAddBaseY (BrIndentSpecial 2) $ cntxtDoc ] in docPar open $ docLines $ list ++ [close] @@ -392,32 +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 = docParenHashLSep + end = docParenHashRSep docAlt - [ docSeq $ [docLit $ Text.pack "(#"] - ++ List.intersperse docCommaSep docs - ++ [docLit $ Text.pack "#)"] + [ docSeq $ [start] + ++ List.intersperse docCommaSep docs + ++ [end] , let - start = docCols ColTyOpPrefix [docLit $ Text.pack "(#", head docs] - lines = List.tail docs <&> \d -> - docCols ColTyOpPrefix [docCommaSep, d] - end = docLit $ Text.pack "#)" + 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