Hack/fix Decl (partial)
parent
75d03534e7
commit
e6a38550a0
|
@ -40,7 +40,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.EPCompat
|
import Language.Haskell.Brittany.Internal.EPCompat
|
||||||
|
|
||||||
layoutDecl :: ToBriDoc an HsDecl
|
layoutDecl :: ToBriDoc AnnListItem HsDecl
|
||||||
layoutDecl d@(L loc decl) = case decl of
|
layoutDecl d@(L loc decl) = case decl of
|
||||||
SigD _ sig -> withTransformedAnns d $ layoutSig (L loc sig)
|
SigD _ sig -> withTransformedAnns d $ layoutSig (L loc sig)
|
||||||
ValD _ bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
|
ValD _ bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
|
||||||
|
@ -57,9 +57,9 @@ layoutDecl d@(L loc decl) = case decl of
|
||||||
-- Sig
|
-- Sig
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
layoutSig :: ToBriDoc an Sig
|
layoutSig :: ToBriDoc AnnListItem Sig
|
||||||
layoutSig lsig@(L _loc sig) = case sig of
|
layoutSig lsig@(L _loc sig) = case sig of
|
||||||
TypeSig _ names (HsWC _ (L _ typ)) -> layoutNamesAndType Nothing names typ
|
TypeSig _ names (HsWC _ (L _ (HsSig _ _ typ))) -> layoutNamesAndType Nothing names typ
|
||||||
InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->
|
InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->
|
||||||
docWrapNode lsig $ do
|
docWrapNode lsig $ do
|
||||||
nameStr <- lrdrNameToTextAnn name
|
nameStr <- lrdrNameToTextAnn name
|
||||||
|
@ -80,8 +80,8 @@ layoutSig lsig@(L _loc sig) = case sig of
|
||||||
$ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
|
$ Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
|
||||||
<> nameStr
|
<> nameStr
|
||||||
<> Text.pack " #-}"
|
<> Text.pack " #-}"
|
||||||
ClassOpSig _ False names (L _ typ) -> layoutNamesAndType Nothing names typ
|
ClassOpSig _ False names (L _ (HsSig _ _ typ)) -> layoutNamesAndType Nothing names typ
|
||||||
PatSynSig _ names (L _ typ) ->
|
PatSynSig _ names (L _ (HsSig _ _ typ)) ->
|
||||||
layoutNamesAndType (Just "pattern") names typ
|
layoutNamesAndType (Just "pattern") names typ
|
||||||
_ -> briDocByExactNoComment lsig -- TODO
|
_ -> briDocByExactNoComment lsig -- TODO
|
||||||
where
|
where
|
||||||
|
@ -160,7 +160,7 @@ layoutBind lbind@(L _ bind) = case bind of
|
||||||
patDocs <- colsWrapPat =<< layoutPat pat
|
patDocs <- colsWrapPat =<< layoutPat pat
|
||||||
clauseDocs <- layoutGrhs `mapM` grhss
|
clauseDocs <- layoutGrhs `mapM` grhss
|
||||||
mWhereDocs <- layoutLocalBinds whereBinds
|
mWhereDocs <- layoutLocalBinds whereBinds
|
||||||
let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
|
let mWhereArg = mWhereDocs <&> (,) (undefined lbind) -- TODO: is this the right AnnKey?
|
||||||
binderDoc <- docLit $ Text.pack "="
|
binderDoc <- docLit $ Text.pack "="
|
||||||
hasComments <- hasAnyCommentsBelow lbind
|
hasComments <- hasAnyCommentsBelow lbind
|
||||||
fmap Right $ docWrapNode lbind $ layoutPatternBindFinal
|
fmap Right $ docWrapNode lbind $ layoutPatternBindFinal
|
||||||
|
@ -198,8 +198,9 @@ bindOrSigtoSrcSpan (BagBind (L l _)) = l
|
||||||
bindOrSigtoSrcSpan (BagSig (L l _)) = l
|
bindOrSigtoSrcSpan (BagSig (L l _)) = l
|
||||||
|
|
||||||
layoutLocalBinds
|
layoutLocalBinds
|
||||||
:: ToBriDocC an (HsLocalBindsLR GhcPs GhcPs) (Maybe [BriDocNumbered])
|
:: HsLocalBindsLR GhcPs GhcPs -> ToBriDocM (Maybe [BriDocNumbered])
|
||||||
layoutLocalBinds lbinds@(L _ binds) = case binds of
|
-- :: ToBriDocC an (HsLocalBindsLR GhcPs GhcPs) (Maybe [BriDocNumbered])
|
||||||
|
layoutLocalBinds binds = case binds of
|
||||||
-- HsValBinds (ValBindsIn lhsBindsLR []) ->
|
-- HsValBinds (ValBindsIn lhsBindsLR []) ->
|
||||||
-- Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering
|
-- Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering
|
||||||
-- x@(HsValBinds (ValBindsIn{})) ->
|
-- x@(HsValBinds (ValBindsIn{})) ->
|
||||||
|
@ -210,7 +211,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
|
||||||
[ BagBind b | b <- Data.Foldable.toList bindlrs ]
|
[ BagBind b | b <- Data.Foldable.toList bindlrs ]
|
||||||
++ [ BagSig s | s <- sigs ]
|
++ [ BagSig s | s <- sigs ]
|
||||||
ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
|
ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
|
||||||
docs <- docWrapNode lbinds $ join <$> ordered `forM` \case
|
docs <- docWrapNode (noLocA binds) $ join <$> ordered `forM` \case
|
||||||
BagBind b -> either id return <$> layoutBind b
|
BagBind b -> either id return <$> layoutBind b
|
||||||
BagSig s -> return <$> layoutSig s
|
BagSig s -> return <$> layoutSig s
|
||||||
return $ Just $ docs
|
return $ Just $ docs
|
||||||
|
@ -610,8 +611,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
|
||||||
|
|
||||||
-- | Layout a pattern synonym binding
|
-- | Layout a pattern synonym binding
|
||||||
layoutPatSynBind
|
layoutPatSynBind
|
||||||
:: Located (IdP GhcPs)
|
:: LIdP GhcPs
|
||||||
-> HsPatSynDetails (Located (IdP GhcPs))
|
-> HsPatSynDetails GhcPs
|
||||||
-> HsPatSynDir GhcPs
|
-> HsPatSynDir GhcPs
|
||||||
-> LPat GhcPs
|
-> LPat GhcPs
|
||||||
-> ToBriDocM BriDocNumbered
|
-> ToBriDocM BriDocNumbered
|
||||||
|
@ -663,8 +664,8 @@ layoutPatSynBind name patSynDetails patDir rpat = do
|
||||||
|
|
||||||
-- | Helper method for the left hand side of a pattern synonym
|
-- | Helper method for the left hand side of a pattern synonym
|
||||||
layoutLPatSyn
|
layoutLPatSyn
|
||||||
:: LocatedAn an (IdP GhcPs)
|
:: LIdP GhcPs
|
||||||
-> HsPatSynDetails (Located (IdP GhcPs))
|
-> HsPatSynDetails GhcPs
|
||||||
-> ToBriDocM BriDocNumbered
|
-> ToBriDocM BriDocNumbered
|
||||||
layoutLPatSyn name (PrefixCon _ vars) = do
|
layoutLPatSyn name (PrefixCon _ vars) = do
|
||||||
docName <- lrdrNameToTextAnn name
|
docName <- lrdrNameToTextAnn name
|
||||||
|
|
Loading…
Reference in New Issue