hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Rewrite non-recommended usage of docLines

pull/287/head
Lennart Spitzner 2020-03-21 21:50:42 +01:00
parent dfa3fef56c
commit 2d07900005
1 changed files with 31 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
View File

@ -1,5 +1,8 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.Brittany.Internal.Layouters.Decl module Language.Haskell.Brittany.Internal.Layouters.Decl
( layoutDecl ( layoutDecl
@ -746,28 +749,38 @@ layoutPatSynBind name patSynDetails patDir rpat = do
mWhereDocs <- layoutPatSynWhere patDir mWhereDocs <- layoutPatSynWhere patDir
runFilteredAlternative $ do runFilteredAlternative $ do
addAlternative $ addAlternative $
docLines $ -- pattern .. where
[ docSeq $ fmap appSep -- ..
-- ..
docAddBaseY BrIndentRegular $ docSeq $
[ patDoc [ patDoc
, docSeparator
, layoutLPatSyn name patSynDetails , layoutLPatSyn name patSynDetails
, binderDoc, body] , docSeparator
<> case mWhereDocs of , binderDoc
Just _ -> [whereDoc] , docSeparator
, body
] ++ case mWhereDocs of
Just ds -> [docSeparator, docPar whereDoc (docSeq ds)]
Nothing -> [] Nothing -> []
] <> case mWhereDocs of
Just x -> [docEnsureIndent BrIndentRegular . docSeq $ fmap pure x]
Nothing -> []
addAlternative $ addAlternative $
docLines $ -- pattern .. =
[ docSeq $ appSep <$> [ patDoc, layoutLPatSyn name patSynDetails, binderDoc] -- ..
, docEnsureIndent BrIndentRegular . docSeq -- pattern .. <-
$ appSep body : case mWhereDocs of -- .. where
Just _ -> [whereDoc] -- ..
Nothing -> [] -- ..
] <> case mWhereDocs of docAddBaseY BrIndentRegular $ docPar
Just x -> [docEnsureIndent BrIndentRegular . docSeq $ fmap pure x] (docSeq $ appSep <$> [ patDoc, layoutLPatSyn name patSynDetails, binderDoc])
(docLines $
[ docSeq $ body : case mWhereDocs of
Just _ -> [docSeparator, whereDoc]
Nothing -> [] Nothing -> []
] <> case mWhereDocs of
Just x -> [docSeq x]
Nothing -> []
)
-- | Helper method for the left hand side of a pattern synonym -- | Helper method for the left hand side of a pattern synonym
layoutLPatSyn layoutLPatSyn
@ -805,7 +818,7 @@ layoutLPatSyn name (RecordPatSyn recArgs) = do
-- | Helper method to get the where clause from of explicitly bidirectional -- | Helper method to get the where clause from of explicitly bidirectional
-- pattern synonyms -- pattern synonyms
layoutPatSynWhere :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [BriDocNumbered]) layoutPatSynWhere :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [ToBriDocM BriDocNumbered])
layoutPatSynWhere hs = case hs of layoutPatSynWhere hs = case hs of
#if MIN_VERSION_ghc(8,6,0) #if MIN_VERSION_ghc(8,6,0)
ExplicitBidirectional (MG _ (L _ lbinds) _) -> do ExplicitBidirectional (MG _ (L _ lbinds) _) -> do
@ -813,7 +826,7 @@ layoutPatSynWhere hs = case hs of
ExplicitBidirectional (MG (L _ lbinds) _ _ _) -> do ExplicitBidirectional (MG (L _ lbinds) _ _ _) -> do
#endif #endif
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
Just <$> mapM (layoutPatternBind Nothing binderDoc) lbinds Just <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds
_ -> pure Nothing _ -> pure Nothing
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------