Add some documentation for `layoutPat`

pull/95/head
Lennart Spitzner 2017-12-11 17:13:33 +01:00
parent 95e4346742
commit 0036dbf410
1 changed files with 30 additions and 0 deletions

View File

@ -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 :: ToBriDocC (Pat RdrName) (Seq BriDocNumbered)
layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr
VarPat n -> fmap Seq.singleton $ docLit $ lrdrNameToText n VarPat n -> fmap Seq.singleton $ docLit $ lrdrNameToText n
-- abc -> expr
LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
-- 0 -> expr
ParPat inner -> do ParPat inner -> do
-- (nestedpat) -> expr
left <- docLit $ Text.pack "(" left <- docLit $ Text.pack "("
right <- docLit $ Text.pack ")" right <- docLit $ Text.pack ")"
innerDocs <- colsWrapPat =<< layoutPat inner innerDocs <- colsWrapPat =<< layoutPat inner
@ -49,6 +63,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- xN' <- docSeq [return xN, docLit $ Text.pack ")"] -- xN' <- docSeq [return xN, docLit $ Text.pack ")"]
-- return $ (x1' Seq.<| middle) Seq.|> xN' -- return $ (x1' Seq.<| middle) Seq.|> xN'
ConPatIn lname (PrefixCon args) -> do ConPatIn lname (PrefixCon args) -> do
-- Abc a b c -> expr
let nameDoc = lrdrNameToText lname let nameDoc = lrdrNameToText lname
argDocs <- layoutPat `mapM` args argDocs <- layoutPat `mapM` args
if null argDocs if null argDocs
@ -61,15 +76,19 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
$ fmap colsWrapPat argDocs $ fmap colsWrapPat argDocs
return $ x1 Seq.<| xR return $ x1 Seq.<| xR
ConPatIn lname (InfixCon left right) -> do ConPatIn lname (InfixCon left right) -> do
-- a :< b -> expr
let nameDoc = lrdrNameToText lname let nameDoc = lrdrNameToText lname
leftDoc <- colsWrapPat =<< layoutPat left leftDoc <- colsWrapPat =<< layoutPat left
rightDoc <- colsWrapPat =<< layoutPat right rightDoc <- colsWrapPat =<< layoutPat right
middle <- docLit nameDoc middle <- docLit nameDoc
return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc
ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do
-- Abc{} -> expr
let t = lrdrNameToText lname let t = lrdrNameToText lname
fmap Seq.singleton $ docLit $ t <> Text.pack "{}" fmap Seq.singleton $ docLit $ t <> Text.pack "{}"
ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
-- Abc { a = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
fExpDoc <- if pun fExpDoc <- if pun
@ -91,12 +110,14 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
, docLit $ Text.pack "}" , docLit $ Text.pack "}"
] ]
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
-- Abc { .. } -> expr
let t = lrdrNameToText lname let t = lrdrNameToText lname
fmap Seq.singleton $ docSeq fmap Seq.singleton $ docSeq
[ appSep $ docLit t [ appSep $ docLit t
, docLit $ Text.pack "{..}" , docLit $ Text.pack "{..}"
] ]
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
-- Abc { a = locA, .. }
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
fExpDoc <- if pun fExpDoc <- if pun
@ -117,16 +138,20 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
, docLit $ Text.pack "..}" , docLit $ Text.pack "..}"
] ]
TuplePat args boxity _ -> do TuplePat args boxity _ -> do
-- (nestedpat1, nestedpat2, nestedpat3) -> expr
-- (#nestedpat1, nestedpat2, nestedpat3#) -> expr
case boxity of case boxity of
Boxed -> wrapPatListy args "(" ")" Boxed -> wrapPatListy args "(" ")"
Unboxed -> wrapPatListy args "(#" "#)" Unboxed -> wrapPatListy args "(#" "#)"
AsPat asName asPat -> do AsPat asName asPat -> do
-- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do
#else /* ghc-8.0 */ #else /* ghc-8.0 */
SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do
#endif #endif
-- i :: Int -> expr
patDocs <- layoutPat pat1 patDocs <- layoutPat pat1
tyDoc <- docSharedWrapper layoutType ty1 tyDoc <- docSharedWrapper layoutType ty1
case Seq.viewr patDocs of case Seq.viewr patDocs of
@ -146,12 +171,17 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
] ]
return $ xR Seq.|> xN' return $ xR Seq.|> xN'
ListPat elems _ _ -> ListPat elems _ _ ->
-- [] -> expr1
-- [nestedpat1, nestedpat2, nestedpat3] -> expr2
wrapPatListy elems "[" "]" wrapPatListy elems "[" "]"
BangPat pat1 -> do BangPat pat1 -> do
-- !nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "!") wrapPatPrepend pat1 (docLit $ Text.pack "!")
LazyPat pat1 -> do LazyPat pat1 -> do
-- ~nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "~") wrapPatPrepend pat1 (docLit $ Text.pack "~")
NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do
-- -13 -> expr
litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit
negDoc <- docLit $ Text.pack "-" negDoc <- docLit $ Text.pack "-"
pure $ case mNegative of pure $ case mNegative of