Merge branch 'master' into inlineconfig
# Conflicts: # src/Language/Haskell/Brittany/Internal.hspull/136/head
commit
1fc007591c
25
.travis.yml
25
.travis.yml
|
|
@ -73,9 +73,12 @@ matrix:
|
|||
- env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.0.2"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.2.1 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.2.1"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.2.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.2.2"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.4.1 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.4.1"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.4.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
|
||||
# Build with the newest GHC and cabal-install. This is an accepted failure,
|
||||
# see below.
|
||||
|
|
@ -85,15 +88,15 @@ matrix:
|
|||
|
||||
##### CABAL DIST CHECK
|
||||
|
||||
- env: BUILD=cabaldist GHCVER=8.2.1 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.2.1 dist"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabaldist GHCVER=8.2.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal 8.2.2 dist"
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
|
||||
##### CANEW #####
|
||||
|
||||
- env: BUILD=canew GHCVER=8.2.1 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal new 8.2.1"
|
||||
addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=canew GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #cabal new 8.2.2"
|
||||
addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
|
||||
##### STACK #####
|
||||
|
||||
|
|
@ -118,6 +121,9 @@ matrix:
|
|||
- env: BUILD=stack ARGS="--stack-yaml stack-8.0.2.yaml"
|
||||
compiler: ": #stack 8.0.2"
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
- env: BUILD=stack ARGS="--stack-yaml stack-8.2.2.yaml"
|
||||
compiler: ": #stack 8.2.2"
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
# Nightly builds are allowed to fail
|
||||
- env: BUILD=stack ARGS="--resolver nightly"
|
||||
|
|
@ -148,6 +154,7 @@ matrix:
|
|||
allow_failures:
|
||||
#- env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
- env: BUILD=stack ARGS="--resolver nightly"
|
||||
- env: BUILD=stack ARGS=""
|
||||
|
||||
before_install:
|
||||
# Using compiler above sets CC to an invalid value, so unset it
|
||||
|
|
|
|||
|
|
@ -83,8 +83,8 @@ library {
|
|||
-j
|
||||
}
|
||||
build-depends:
|
||||
{ base >=4.9 && <4.11
|
||||
, ghc >=8.0.1 && <8.3
|
||||
{ base >=4.9 && <4.12
|
||||
, ghc >=8.0.1 && <8.5
|
||||
, ghc-paths >=0.1.0.9 && <0.2
|
||||
, ghc-exactprint >=0.5.6.0 && <0.5.7
|
||||
, transformers >=0.5.2.0 && <0.6
|
||||
|
|
@ -111,7 +111,7 @@ library {
|
|||
, semigroups >=0.18.2 && <0.19
|
||||
, cmdargs >=0.10.14 && <0.11
|
||||
, czipwith >=1.0.1.0 && <1.1
|
||||
, ghc-boot-th >=8.0.1 && <8.3
|
||||
, ghc-boot-th >=8.0.1 && <8.5
|
||||
, filepath >=1.4.1.0 && <1.5
|
||||
}
|
||||
default-extensions: {
|
||||
|
|
|
|||
|
|
@ -52,7 +52,6 @@ import Language.Haskell.Brittany.Internal.Transformations.Indent
|
|||
|
||||
import qualified GHC as GHC hiding (parseModule)
|
||||
import ApiAnnotation ( AnnKeywordId(..) )
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||
import SrcLoc ( SrcSpan )
|
||||
import HsSyn
|
||||
|
|
@ -436,7 +435,7 @@ toLocal conf anns m = do
|
|||
MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w <> write)
|
||||
pure x
|
||||
|
||||
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
||||
ppModule :: GenLocated SrcSpan (HsModule GhcPs) -> PPM ()
|
||||
ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
|
||||
post <- ppPreamble lmod
|
||||
decls `forM_` \decl -> do
|
||||
|
|
@ -503,7 +502,7 @@ getDeclBindingNames (L _ decl) = case decl of
|
|||
_ -> []
|
||||
|
||||
|
||||
ppDecl :: LHsDecl RdrName -> PPMLocal ()
|
||||
ppDecl :: LHsDecl GhcPs -> PPMLocal ()
|
||||
ppDecl d@(L loc decl) = case decl of
|
||||
SigD sig -> -- trace (_sigHead sig) $
|
||||
withTransformedAnns d $ do
|
||||
|
|
@ -523,7 +522,7 @@ ppDecl d@(L loc decl) = case decl of
|
|||
|
||||
-- Prints the information associated with the module annotation
|
||||
-- This includes the imports
|
||||
ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
|
||||
ppPreamble :: GenLocated SrcSpan (HsModule GhcPs)
|
||||
-> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
|
||||
ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
|
||||
filteredAnns <- mAsk <&> \annMap ->
|
||||
|
|
@ -589,13 +588,13 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
|
|||
in MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule
|
||||
return post
|
||||
|
||||
_sigHead :: Sig RdrName -> String
|
||||
_sigHead :: Sig GhcPs -> String
|
||||
_sigHead = \case
|
||||
TypeSig names _ ->
|
||||
"TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
|
||||
_ -> "unknown sig"
|
||||
|
||||
_bindHead :: HsBind RdrName -> String
|
||||
_bindHead :: HsBind GhcPs -> String
|
||||
_bindHead = \case
|
||||
FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
|
||||
PatBind _pat _ _ _ ([], []) -> "PatBind smth"
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ import Language.Haskell.Brittany.Internal.Config.Types.Instances
|
|||
import Language.Haskell.Brittany.Internal.Utils
|
||||
|
||||
import Data.Coerce ( Coercible, coerce )
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
|
||||
import qualified System.Directory as Directory
|
||||
import qualified System.FilePath.Posix as FilePath
|
||||
|
|
@ -272,7 +273,7 @@ readConfigs
|
|||
-> MaybeT IO Config
|
||||
readConfigs cmdlineConfig configPaths = do
|
||||
configs <- readConfig `mapM` configPaths
|
||||
let merged = Semigroup.mconcat $ reverse (cmdlineConfig:catMaybes configs)
|
||||
let merged = Semigroup.sconcat $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)
|
||||
return $ cZipWith fromOptionIdentity staticDefaultConfig merged
|
||||
|
||||
-- | Reads provided configs
|
||||
|
|
|
|||
|
|
@ -29,10 +29,9 @@ import qualified GHC as GHC hiding (parseModule)
|
|||
import qualified Lexer as GHC
|
||||
import qualified StringBuffer as GHC
|
||||
import qualified Outputable as GHC
|
||||
import RdrName ( RdrName(..) )
|
||||
import qualified CmdLineParser as GHC
|
||||
import HsSyn
|
||||
import SrcLoc ( SrcSpan, Located )
|
||||
import RdrName ( RdrName(..) )
|
||||
|
||||
|
||||
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
|
||||
|
|
@ -79,7 +78,7 @@ parseModuleWithCpp cpp opts args fp dynCheck =
|
|||
when (not $ null warnings)
|
||||
$ ExceptT.throwE
|
||||
$ "when parsing ghc flags: encountered warnings: "
|
||||
++ show (warnings <&> \(L _ s) -> s)
|
||||
++ show (warnings <&> warnExtractorCompat)
|
||||
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
|
||||
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
|
||||
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
|
||||
|
|
@ -111,7 +110,7 @@ parseModuleFromString args fp dynCheck str =
|
|||
when (not $ null warnings)
|
||||
$ ExceptT.throwE
|
||||
$ "when parsing ghc flags: encountered warnings: "
|
||||
++ show (warnings <&> \(L _ s) -> s)
|
||||
++ show (warnings <&> warnExtractorCompat)
|
||||
dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
|
||||
let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
|
||||
case res of
|
||||
|
|
@ -187,7 +186,7 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul
|
|||
where
|
||||
genF :: Data.Data.Data a => a -> ExactPrint.Transform ()
|
||||
genF = (\_ -> return ()) `SYB.extQ` exprF
|
||||
exprF :: Located (HsExpr RdrName) -> ExactPrint.Transform ()
|
||||
exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
|
||||
exprF lexpr@(L _ expr) = case expr of
|
||||
RecordCon _lname _ _ (HsRecFields fs@(_:_) Nothing) ->
|
||||
moveTrailingComments lexpr (List.last fs)
|
||||
|
|
@ -226,7 +225,7 @@ moveTrailingComments astFrom astTo = do
|
|||
-- elements to the relevant annotations. Avoids quadratic behaviour a trivial
|
||||
-- implementation would have.
|
||||
extractToplevelAnns
|
||||
:: Located (HsModule RdrName)
|
||||
:: Located (HsModule GhcPs)
|
||||
-> ExactPrint.Anns
|
||||
-> Map ExactPrint.AnnKey ExactPrint.Anns
|
||||
extractToplevelAnns lmod anns = output
|
||||
|
|
@ -265,3 +264,12 @@ foldedAnnKeys ast = SYB.everything
|
|||
)
|
||||
ast
|
||||
where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
|
||||
warnExtractorCompat :: GHC.Warn -> String
|
||||
warnExtractorCompat (GHC.Warn _ (L _ s)) = s
|
||||
#else /* ghc-8.0 && ghc-8.2 */
|
||||
warnExtractorCompat :: GenLocated l String -> String
|
||||
warnExtractorCompat (L _ s) = s
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -20,7 +20,6 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||
import SrcLoc ( SrcSpan )
|
||||
import HsSyn
|
||||
|
|
@ -88,11 +87,7 @@ layoutSig lsig@(L _loc sig) = case sig of
|
|||
InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->
|
||||
docWrapNode lsig $ do
|
||||
nameStr <- lrdrNameToTextAnn name
|
||||
let specStr = case spec of
|
||||
Inline -> "INLINE "
|
||||
Inlinable -> "INLINABLE "
|
||||
NoInline -> "NOINLINE "
|
||||
EmptyInlineSpec -> "" -- i have no idea if this is correct.
|
||||
specStr <- specStringCompat lsig spec
|
||||
let phaseStr = case phaseAct of
|
||||
NeverActive -> "" -- not [] - for NOINLINE NeverActive is
|
||||
-- in fact the default
|
||||
|
|
@ -108,7 +103,23 @@ layoutSig lsig@(L _loc sig) = case sig of
|
|||
<> Text.pack " #-}"
|
||||
_ -> briDocByExactNoComment lsig -- TODO
|
||||
|
||||
layoutGuardLStmt :: ToBriDoc' (Stmt RdrName (LHsExpr RdrName))
|
||||
specStringCompat
|
||||
:: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String
|
||||
#if MIN_VERSION_ghc(8,4,0)
|
||||
specStringCompat ast = \case
|
||||
NoUserInline -> mTell [ErrorUnknownNode "NoUserInline" ast] $> ""
|
||||
Inline -> pure "INLINE "
|
||||
Inlinable -> pure "INLINABLE "
|
||||
NoInline -> pure "NOINLINE "
|
||||
#else
|
||||
specStringCompat _ = \case
|
||||
Inline -> pure "INLINE "
|
||||
Inlinable -> pure "INLINABLE "
|
||||
NoInline -> pure "NOINLINE "
|
||||
EmptyInlineSpec -> pure ""
|
||||
#endif
|
||||
|
||||
layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
|
||||
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
|
||||
BodyStmt body _ _ _ -> layoutExpr body
|
||||
BindStmt lPat expr _ _ _ -> do
|
||||
|
|
@ -122,7 +133,7 @@ layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
|
|||
|
||||
layoutBind
|
||||
:: ToBriDocC
|
||||
(HsBindLR RdrName RdrName)
|
||||
(HsBindLR GhcPs GhcPs)
|
||||
(Either [BriDocNumbered] BriDocNumbered)
|
||||
layoutBind lbind@(L _ bind) = case bind of
|
||||
FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do
|
||||
|
|
@ -148,15 +159,15 @@ layoutBind lbind@(L _ bind) = case bind of
|
|||
hasComments
|
||||
_ -> Right <$> unknownNodeError "" lbind
|
||||
|
||||
data BagBindOrSig = BagBind (LHsBindLR RdrName RdrName)
|
||||
| BagSig (LSig RdrName)
|
||||
data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs)
|
||||
| BagSig (LSig GhcPs)
|
||||
|
||||
bindOrSigtoSrcSpan :: BagBindOrSig -> SrcSpan
|
||||
bindOrSigtoSrcSpan (BagBind (L l _)) = l
|
||||
bindOrSigtoSrcSpan (BagSig (L l _)) = l
|
||||
|
||||
layoutLocalBinds
|
||||
:: ToBriDocC (HsLocalBindsLR RdrName RdrName) (Maybe [BriDocNumbered])
|
||||
:: ToBriDocC (HsLocalBindsLR GhcPs GhcPs) (Maybe [BriDocNumbered])
|
||||
layoutLocalBinds lbinds@(L _ binds) = case binds of
|
||||
-- HsValBinds (ValBindsIn lhsBindsLR []) ->
|
||||
-- Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering
|
||||
|
|
@ -178,11 +189,11 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
|
|||
x@(HsIPBinds _ipBinds) -> Just . (:[]) <$> unknownNodeError "HsIPBinds" x
|
||||
EmptyLocalBinds -> return $ Nothing
|
||||
|
||||
-- TODO: we don't need the `LHsExpr RdrName` anymore, now that there is
|
||||
-- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
|
||||
-- parSpacing stuff.B
|
||||
layoutGrhs
|
||||
:: LGRHS RdrName (LHsExpr RdrName)
|
||||
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr RdrName)
|
||||
:: LGRHS GhcPs (LHsExpr GhcPs)
|
||||
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)
|
||||
layoutGrhs lgrhs@(L _ (GRHS guards body)) = do
|
||||
guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards
|
||||
bodyDoc <- layoutExpr body
|
||||
|
|
@ -191,12 +202,14 @@ layoutGrhs lgrhs@(L _ (GRHS guards body)) = do
|
|||
layoutPatternBind
|
||||
:: Maybe Text
|
||||
-> BriDocNumbered
|
||||
-> LMatch RdrName (LHsExpr RdrName)
|
||||
-> LMatch GhcPs (LHsExpr GhcPs)
|
||||
-> ToBriDocM BriDocNumbered
|
||||
layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match fixityOrCtx pats _ (GRHSs grhss whereBinds))) = do
|
||||
layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do
|
||||
let pats = m_pats match
|
||||
let (GRHSs grhss whereBinds) = m_grhss match
|
||||
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
|
||||
let isInfix = isInfixMatch match
|
||||
let mIdStr' = fixPatternBindIdentifier fixityOrCtx <$> mIdStr
|
||||
let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
|
||||
patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of
|
||||
(Just idStr, p1 : pr) | isInfix -> docCols
|
||||
ColPatternsFuncInfix
|
||||
|
|
@ -222,25 +235,26 @@ layoutPatternBind mIdStr binderDoc lmatch@(L _ match@(Match fixityOrCtx pats _ (
|
|||
mWhereDocs
|
||||
hasComments
|
||||
|
||||
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
|
||||
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 && ghc-8.4 */
|
||||
fixPatternBindIdentifier
|
||||
:: HsMatchContext (NameOrRdrName RdrName) -> Text -> Text
|
||||
fixPatternBindIdentifier ctx idStr = case ctx of
|
||||
:: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
|
||||
fixPatternBindIdentifier match idStr = go $ m_ctxt match
|
||||
where
|
||||
go = \case
|
||||
(FunRhs _ _ SrcLazy ) -> Text.cons '~' idStr
|
||||
(FunRhs _ _ SrcStrict ) -> Text.cons '!' idStr
|
||||
(FunRhs _ _ NoSrcStrict) -> idStr
|
||||
(StmtCtxt ctx1 ) -> fixPatternBindIdentifier' ctx1
|
||||
(StmtCtxt ctx1 ) -> goInner ctx1
|
||||
_ -> idStr
|
||||
where
|
||||
-- I have really no idea if this path ever occurs, but better safe than
|
||||
-- risking another "drop bangpatterns" bugs.
|
||||
fixPatternBindIdentifier' = \case
|
||||
(PatGuard ctx1) -> fixPatternBindIdentifier ctx1 idStr
|
||||
(ParStmtCtxt ctx1) -> fixPatternBindIdentifier' ctx1
|
||||
(TransStmtCtxt ctx1) -> fixPatternBindIdentifier' ctx1
|
||||
goInner = \case
|
||||
(PatGuard ctx1) -> go ctx1
|
||||
(ParStmtCtxt ctx1) -> goInner ctx1
|
||||
(TransStmtCtxt ctx1) -> goInner ctx1
|
||||
_ -> idStr
|
||||
#else /* ghc-8.0 */
|
||||
fixPatternBindIdentifier :: MatchFixity RdrName -> Text -> Text
|
||||
fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
|
||||
fixPatternBindIdentifier _ x = x
|
||||
#endif
|
||||
|
||||
|
|
@ -248,7 +262,7 @@ layoutPatternBindFinal
|
|||
:: Maybe Text
|
||||
-> BriDocNumbered
|
||||
-> Maybe BriDocNumbered
|
||||
-> [([BriDocNumbered], BriDocNumbered, LHsExpr RdrName)]
|
||||
-> [([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)]
|
||||
-> Maybe [BriDocNumbered]
|
||||
-> Bool
|
||||
-> ToBriDocM BriDocNumbered
|
||||
|
|
|
|||
|
|
@ -15,8 +15,7 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..), RdrName(..) )
|
||||
import HsSyn
|
||||
import Name
|
||||
import qualified FastString
|
||||
|
|
@ -56,7 +55,12 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
allocateNode $ overLitValBriDoc olit
|
||||
HsLit lit -> do
|
||||
allocateNode $ litBriDoc lit
|
||||
HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do
|
||||
HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)
|
||||
| pats <- m_pats match
|
||||
, GRHSs [lgrhs] llocals <- m_grhss match
|
||||
, L _ EmptyLocalBinds <- llocals
|
||||
, L _ (GRHS [] body) <- lgrhs
|
||||
-> do
|
||||
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
|
||||
bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
|
||||
let funcPatternPartLine =
|
||||
|
|
@ -112,7 +116,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
(docLit $ Text.pack "\\case")
|
||||
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
|
||||
HsApp exp1@(L _ HsApp{}) exp2 -> do
|
||||
let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName])
|
||||
let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
|
||||
gather list = \case
|
||||
L _ (HsApp l r) -> gather (r:list) l
|
||||
x -> (x, list)
|
||||
|
|
@ -220,7 +224,7 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
-- TODO
|
||||
briDocByExactInlineOnly "HsAppTypeOut{}" lexpr
|
||||
OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do
|
||||
let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)])
|
||||
let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])
|
||||
gather opExprList = \case
|
||||
(L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1
|
||||
final -> (final, opExprList)
|
||||
|
|
@ -1077,7 +1081,31 @@ layoutExpr lexpr@(L _ expr) = do
|
|||
#endif
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
|
||||
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
|
||||
litBriDoc :: HsLit GhcPs -> BriDocFInt
|
||||
litBriDoc = \case
|
||||
HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsCharPrim (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
HsString (SourceText t) _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString
|
||||
HsStringPrim (SourceText t) _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
|
||||
HsInt _ (IL (SourceText t) _ _) -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsIntPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsWordPrim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsInt64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsWord64Prim (SourceText t) _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsInteger (SourceText t) _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
|
||||
HsRat _ (FL (SourceText t) _ _) _type -> BDFLit $ Text.pack t
|
||||
HsFloatPrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
|
||||
HsDoublePrim _ (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
|
||||
_ -> error "litBriDoc: literal with no SourceText"
|
||||
|
||||
overLitValBriDoc :: OverLitVal -> BriDocFInt
|
||||
overLitValBriDoc = \case
|
||||
HsIntegral (IL (SourceText t) _ _) -> BDFLit $ Text.pack t
|
||||
HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
|
||||
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
|
||||
_ -> error "overLitValBriDoc: literal with no SourceText"
|
||||
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
|
||||
litBriDoc :: HsLit -> BriDocFInt
|
||||
litBriDoc = \case
|
||||
HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
|
|
@ -1101,7 +1129,7 @@ overLitValBriDoc = \case
|
|||
HsFractional (FL t _) -> BDFLit $ Text.pack t
|
||||
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
|
||||
_ -> error "overLitValBriDoc: literal with no SourceText"
|
||||
#else
|
||||
#else /* ghc-8.0 */
|
||||
litBriDoc :: HsLit -> BriDocFInt
|
||||
litBriDoc = \case
|
||||
HsChar t _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@ where
|
|||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||
import HsSyn
|
||||
import Name
|
||||
|
|
@ -23,8 +22,12 @@ import Name
|
|||
|
||||
layoutExpr :: ToBriDoc HsExpr
|
||||
|
||||
-- layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))
|
||||
-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
|
||||
|
||||
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
|
||||
litBriDoc :: HsLit GhcPs -> BriDocFInt
|
||||
#else /* ghc-8.0 && ghc-8.2 */
|
||||
litBriDoc :: HsLit -> BriDocFInt
|
||||
#endif
|
||||
|
||||
overLitValBriDoc :: OverLitVal -> BriDocFInt
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName (RdrName(..))
|
||||
import GHC ( unLoc
|
||||
, runGhc
|
||||
, GenLocated(L)
|
||||
|
|
@ -89,7 +88,7 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
|
|||
-- handling of the resulting list. Adding parens is
|
||||
-- left to the caller since that is context sensitive
|
||||
layoutAnnAndSepLLIEs
|
||||
:: Located [LIE RdrName] -> ToBriDocM [ToBriDocM BriDocNumbered]
|
||||
:: Located [LIE GhcPs] -> ToBriDocM [ToBriDocM BriDocNumbered]
|
||||
layoutAnnAndSepLLIEs llies@(L _ lies) = do
|
||||
let makeIENode ie = docSeq [docCommaSep, ie]
|
||||
let ieDocs = layoutIE <$> lies
|
||||
|
|
@ -114,7 +113,7 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do
|
|||
-- () -- no comments
|
||||
-- ( -- a comment
|
||||
-- )
|
||||
layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
|
||||
layoutLLIEs :: Bool -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
|
||||
layoutLLIEs enableSingleline llies = do
|
||||
ieDs <- layoutAnnAndSepLLIEs llies
|
||||
hasComments <- hasAnyCommentsBelow llies
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
import Language.Haskell.Brittany.Internal.Layouters.IE
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( unLoc
|
||||
, GenLocated(L)
|
||||
, moduleNameString
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@ import Language.Haskell.Brittany.Internal.Layouters.IE
|
|||
import Language.Haskell.Brittany.Internal.Layouters.Import
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName (RdrName(..))
|
||||
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
|
||||
import HsSyn
|
||||
import Name
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@ where
|
|||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
||||
import HsSyn
|
||||
import Name
|
||||
|
|
@ -34,7 +33,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
|
|||
-- ^^^^^^^^^^ 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 GhcPs) (Seq BriDocNumbered)
|
||||
layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
|
||||
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
|
||||
-- _ -> expr
|
||||
|
|
@ -199,7 +198,7 @@ colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
|
|||
colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
|
||||
|
||||
wrapPatPrepend
|
||||
:: Located (Pat RdrName)
|
||||
:: Located (Pat GhcPs)
|
||||
-> ToBriDocM BriDocNumbered
|
||||
-> ToBriDocM (Seq BriDocNumbered)
|
||||
wrapPatPrepend pat prepElem = do
|
||||
|
|
@ -211,7 +210,7 @@ wrapPatPrepend pat prepElem = do
|
|||
return $ x1' Seq.<| xR
|
||||
|
||||
wrapPatListy
|
||||
:: [Located (Pat RdrName)]
|
||||
:: [Located (Pat GhcPs)]
|
||||
-> String
|
||||
-> String
|
||||
-> ToBriDocM (Seq BriDocNumbered)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||
import HsSyn
|
||||
import Name
|
||||
|
|
@ -26,7 +25,7 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
|||
|
||||
|
||||
|
||||
layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))
|
||||
layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
|
||||
layoutStmt lstmt@(L _ stmt) = do
|
||||
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
|
||||
docWrapNode lstmt $ case stmt of
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@ where
|
|||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||
import HsSyn
|
||||
import Name
|
||||
|
|
@ -21,4 +20,4 @@ import BasicTypes
|
|||
|
||||
|
||||
|
||||
layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName))
|
||||
layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@ import Language.Haskell.Brittany.Internal.Config.Types
|
|||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( runGhc
|
||||
, GenLocated(L)
|
||||
, moduleNameString
|
||||
|
|
|
|||
|
|
@ -1,8 +1,24 @@
|
|||
module Language.Haskell.Brittany.Internal.Prelude (module E)
|
||||
module Language.Haskell.Brittany.Internal.Prelude
|
||||
( module E
|
||||
, module Language.Haskell.Brittany.Internal.Prelude
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
|
||||
-- rather project-specific stuff:
|
||||
---------------------------------
|
||||
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
|
||||
import HsExtension as E ( GhcPs )
|
||||
#endif
|
||||
|
||||
import RdrName as E ( RdrName )
|
||||
|
||||
|
||||
|
||||
-- more general:
|
||||
----------------
|
||||
|
||||
import Data.Functor.Identity as E ( Identity(..) )
|
||||
import Control.Concurrent.Chan as E ( Chan )
|
||||
import Control.Concurrent.MVar as E ( MVar )
|
||||
|
|
@ -379,3 +395,10 @@ import Control.Monad.Trans.Maybe as E ( MaybeT (..)
|
|||
import Data.Data as E ( toConstr
|
||||
)
|
||||
|
||||
todo :: a
|
||||
todo = error "todo"
|
||||
|
||||
|
||||
#if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */
|
||||
type GhcPs = RdrName
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
|||
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
|
||||
import RdrName ( RdrName(..) )
|
||||
import GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId )
|
||||
|
||||
import Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )
|
||||
|
|
@ -205,7 +204,7 @@ data BrIndent = BrIndentNone
|
|||
|
||||
type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[BrittanyError], Seq String] '[NodeAllocIndex]
|
||||
|
||||
type ToBriDoc (sym :: * -> *) = Located (sym RdrName) -> ToBriDocM BriDocNumbered
|
||||
type ToBriDoc (sym :: * -> *) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
|
||||
type ToBriDoc' sym = Located sym -> ToBriDocM BriDocNumbered
|
||||
type ToBriDocC sym c = Located sym -> ToBriDocM c
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue