Add some documentation for `layoutPat`
parent
95e4346742
commit
0036dbf410
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue