From 0036dbf41086030083ba9aec3f0165c06fe62f30 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 11 Dec 2017 17:13:33 +0100 Subject: [PATCH 1/3] Add some documentation for `layoutPat` --- .../Brittany/Internal/Layouters/Pattern.hs | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index 3f66932..ebdd91d 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -24,12 +24,26 @@ import Language.Haskell.Brittany.Internal.Layouters.Type +-- | layouts patterns (inside function bindings, case alternatives, let +-- bindings or do notation). E.g. for input +-- > case computation of +-- > (warnings, Success a b) -> .. +-- This part ^^^^^^^^^^^^^^^^^^^^^^^ of the syntax tree is layouted by +-- 'layoutPat'. Similarly for +-- > func abc True 0 = [] +-- ^^^^^^^^^^ this part +-- We will use `case .. of` as the imagined prefix to the examples used in +-- the different cases below. layoutPat :: ToBriDocC (Pat RdrName) (Seq BriDocNumbered) layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" + -- _ -> expr VarPat n -> fmap Seq.singleton $ docLit $ lrdrNameToText n + -- abc -> expr LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit + -- 0 -> expr ParPat inner -> do + -- (nestedpat) -> expr left <- docLit $ Text.pack "(" right <- docLit $ Text.pack ")" innerDocs <- colsWrapPat =<< layoutPat inner @@ -49,6 +63,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of -- xN' <- docSeq [return xN, docLit $ Text.pack ")"] -- return $ (x1' Seq.<| middle) Seq.|> xN' ConPatIn lname (PrefixCon args) -> do + -- Abc a b c -> expr let nameDoc = lrdrNameToText lname argDocs <- layoutPat `mapM` args if null argDocs @@ -61,15 +76,19 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of $ fmap colsWrapPat argDocs return $ x1 Seq.<| xR ConPatIn lname (InfixCon left right) -> do + -- a :< b -> expr let nameDoc = lrdrNameToText lname leftDoc <- colsWrapPat =<< layoutPat left rightDoc <- colsWrapPat =<< layoutPat right middle <- docLit nameDoc return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do + -- Abc{} -> expr let t = lrdrNameToText lname fmap Seq.singleton $ docLit $ t <> Text.pack "{}" ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do + -- Abc { a = locA, b = locB, c = locC } -> expr1 + -- Abc { a, b, c } -> expr2 let t = lrdrNameToText lname fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do fExpDoc <- if pun @@ -91,12 +110,14 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of , docLit $ Text.pack "}" ] ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do + -- Abc { .. } -> expr let t = lrdrNameToText lname fmap Seq.singleton $ docSeq [ appSep $ docLit t , docLit $ Text.pack "{..}" ] ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do + -- Abc { a = locA, .. } let t = lrdrNameToText lname fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do fExpDoc <- if pun @@ -117,16 +138,20 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of , docLit $ Text.pack "..}" ] TuplePat args boxity _ -> do + -- (nestedpat1, nestedpat2, nestedpat3) -> expr + -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr case boxity of Boxed -> wrapPatListy args "(" ")" Unboxed -> wrapPatListy args "(#" "#)" AsPat asName asPat -> do + -- bind@nestedpat -> expr wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do #else /* ghc-8.0 */ SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do #endif + -- i :: Int -> expr patDocs <- layoutPat pat1 tyDoc <- docSharedWrapper layoutType ty1 case Seq.viewr patDocs of @@ -146,12 +171,17 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of ] return $ xR Seq.|> xN' ListPat elems _ _ -> + -- [] -> expr1 + -- [nestedpat1, nestedpat2, nestedpat3] -> expr2 wrapPatListy elems "[" "]" BangPat pat1 -> do + -- !nestedpat -> expr wrapPatPrepend pat1 (docLit $ Text.pack "!") LazyPat pat1 -> do + -- ~nestedpat -> expr wrapPatPrepend pat1 (docLit $ Text.pack "~") NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do + -- -13 -> expr litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit negDoc <- docLit $ Text.pack "-" pure $ case mNegative of -- 2.30.2 From b731cd15e7e69fb3d793af906d9c05ca76c3879a Mon Sep 17 00:00:00 2001 From: Matthew Piziak Date: Thu, 14 Dec 2017 16:17:39 -0500 Subject: [PATCH 2/3] capture starting layout --- src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 0ed8a31..2eb1863 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -341,9 +341,9 @@ layoutExpr lexpr@(L _ expr) = do opDoc <- docSharedWrapper layoutExpr op rightDoc <- docSharedWrapper layoutExpr right docSeq [opDoc, docSeparator, rightDoc] - ExplicitTuple args boxity - | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do - argDocs <- docSharedWrapper layoutExpr `mapM` argExprs + ExplicitTuple args boxity -> do + let argExprs = fmap (\case (L _ (Present e)) -> Just e; (L _ (Missing PlaceHolder)) -> Nothing) args + argDocs <- docSharedWrapper (maybe docEmpty layoutExpr) `mapM` argExprs hasComments <- hasAnyCommentsBelow lexpr let (openLit, closeLit) = case boxity of Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") @@ -385,8 +385,6 @@ layoutExpr lexpr@(L _ expr) = do end = closeLit in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] ] - ExplicitTuple{} -> - unknownNodeError "ExplicitTuple|.." lexpr HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do cExpDoc <- docSharedWrapper layoutExpr cExp binderDoc <- docLit $ Text.pack "->" -- 2.30.2 From 9704fc34908bba3a6e6c4e1ccd04ca0382b19e92 Mon Sep 17 00:00:00 2001 From: Matthew Piziak Date: Thu, 14 Dec 2017 18:15:07 -0500 Subject: [PATCH 3/3] add tuple section tests --- src-literatetests/10-tests.blt | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index c6d4203..a3d8591 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -476,9 +476,23 @@ func = (`abc` 1) #group tuples ### -#test 1 +#test pair func = (abc, def) +#test pair section left +func = (abc, ) + +#test pair section right +func = (, abc) + +#test quintuple section long +myTupleSection = + ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement + , + , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement + , + ) + #test 2 #pending func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd -- 2.30.2