Support GHC 8.10 #324

Merged
tfausak merged 19 commits from gh-269-ghc-8.10 into master 2020-12-10 03:50:24 +01:00
36 changed files with 196 additions and 1139 deletions

View File

@ -9,28 +9,23 @@ on:
jobs: jobs:
build: build:
strategy: strategy:
fail-fast: false
matrix: matrix:
os: os:
- macos-10.15 - macos-10.15
- ubuntu-18.04 - ubuntu-18.04
- windows-2019 - windows-2019
ghc: ghc:
- 8.8.4 - 8.10.2
cabal: cabal:
- 3.2.0.0 - 3.2.0.0
include: include:
- os: ubuntu-18.04
ghc: 8.8.4
cabal: 3.2.0.0
- os: ubuntu-18.04 - os: ubuntu-18.04
ghc: 8.6.5 ghc: 8.6.5
cabal: 3.2.0.0 cabal: 3.2.0.0
- os: ubuntu-18.04
ghc: 8.4.4
cabal: 3.2.0.0
- os: ubuntu-18.04
ghc: 8.2.2
cabal: 3.2.0.0
- os: ubuntu-18.04
ghc: 8.0.2
cabal: 3.2.0.0
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
@ -55,7 +50,7 @@ jobs:
with: with:
path: output/brittany* path: output/brittany*
name: brittany-${{ matrix.os }}-ghc-${{ matrix.ghc }}-${{ github.sha }} name: brittany-${{ matrix.os }}-ghc-${{ matrix.ghc }}-${{ github.sha }}
- if: matrix.os == 'ubuntu-18.04' && matrix.ghc == '8.8.4' - if: matrix.os == 'ubuntu-18.04' && matrix.ghc == '8.10.2'
uses: actions/upload-artifact@v2 uses: actions/upload-artifact@v2
with: with:
path: dist-newstyle/sdist/brittany-*.tar.gz path: dist-newstyle/sdist/brittany-*.tar.gz

View File

@ -40,25 +40,11 @@ before_cache:
# addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
matrix: matrix:
include: include:
##### OSX test via stack ##### ##### OSX test via stack #####
# Build on macOS in addition to Linux
- env: BUILD=stack ARGS="--stack-yaml stack-8.2.2.yaml"
compiler: ": #stack 8.2.2 osx"
os: osx
##### CABAL ##### ##### CABAL #####
- 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.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.4 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #cabal 8.4.4"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.4.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
- env: BUILD=cabal GHCVER=8.6.5 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 - env: BUILD=cabal GHCVER=8.6.5 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #cabal 8.6.5" compiler: ": #cabal 8.6.5"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.6.5,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.24,ghc-8.6.5,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
@ -69,17 +55,8 @@ matrix:
# compiler: ": #GHC HEAD" # compiler: ": #GHC HEAD"
# addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} # addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
##### CABAL DIST CHECK
- 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 ##### ##### CANEW #####
- 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]}}
- env: BUILD=canew GHCVER=8.8.1 CABALVER=3.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 - env: BUILD=canew GHCVER=8.8.1 CABALVER=3.0 HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #cabal new 8.8.1" compiler: ": #cabal new 8.8.1"
addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
@ -92,15 +69,10 @@ matrix:
compiler: ": #stack default" compiler: ": #stack default"
addons: {apt: {packages: [libgmp-dev]}} addons: {apt: {packages: [libgmp-dev]}}
- env: BUILD=stack ARGS="--stack-yaml stack-8.0.2.yaml" - env: BUILD=stack ARGS="--stack-yaml stack-8.8.4.yaml"
compiler: ": #stack 8.0.2" compiler: ": #stack 8.8.4"
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]}}
- env: BUILD=stack ARGS="--stack-yaml stack-8.4.3.yaml"
compiler: ": #stack 8.4.3"
addons: {apt: {packages: [libgmp-dev]}} addons: {apt: {packages: [libgmp-dev]}}
- env: BUILD=stack ARGS="--stack-yaml stack-8.6.5.yaml" - env: BUILD=stack ARGS="--stack-yaml stack-8.6.5.yaml"
compiler: ": #stack 8.6.5" compiler: ": #stack 8.6.5"
addons: {apt: {packages: [libgmp-dev]}} addons: {apt: {packages: [libgmp-dev]}}
@ -202,7 +174,7 @@ install:
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
cabal install -j$JOBS --only-dependencies --enable-tests --enable-benchmarks --ghc-options="-j1 +RTS -M700M -RTS"; cabal install -j$JOBS --only-dependencies --enable-tests --enable-benchmarks --ghc-options="-j1 +RTS -M700M -RTS";
fi fi
# snapshot package-db on cache miss # snapshot package-db on cache miss
if [ ! -d $HOME/.cabsnap ]; if [ ! -d $HOME/.cabsnap ];
then then

View File

@ -5,24 +5,14 @@ test:
.PHONY: test-all .PHONY: test-all
test-all: test-all:
$(MAKE) test test-8.6.5 test-8.4.3 test-8.2.2 test-8.0.2 $(MAKE) test test-8.8.4 test-8.6.5
.PHONY: test-8.8.4
test-8.8.4:
echo "test 8.8.4"
stack test --stack-yaml stack-8.8.4.yaml --work-dir .stack-work-8.8.4
.PHONY: test-8.6.5 .PHONY: test-8.6.5
test-8.6.5: test-8.6.5:
echo "test 8.6.5" echo "test 8.6.5"
stack test --stack-yaml stack-8.6.5.yaml --work-dir .stack-work-8.6.5 stack test --stack-yaml stack-8.6.5.yaml --work-dir .stack-work-8.6.5
.PHONY: test-8.4.3
test-8.4.3:
echo "test 8.4.3"
stack test --stack-yaml stack-8.4.3.yaml --work-dir .stack-work-8.4.3
.PHONY: test-8.2.2
test-8.2.2:
echo "test 8.2.2"
stack test --stack-yaml stack-8.2.2.yaml --work-dir .stack-work-8.2.2
.PHONY: test-8.0.2
test-8.0.2:
echo "test 8.0.2"
stack test --stack-yaml stack-8.0.2.yaml --work-dir .stack-work-8.0.2

View File

@ -1,4 +1,4 @@
# brittany [![Hackage version](https://img.shields.io/hackage/v/brittany.svg?label=Hackage)](https://hackage.haskell.org/package/brittany) [![Stackage version](https://www.stackage.org/package/brittany/badge/lts?label=Stackage)](https://www.stackage.org/package/brittany) [![Build Status](https://secure.travis-ci.org/lspitzner/brittany.svg?branch=master)](http://travis-ci.org/lspitzner/brittany) # brittany [![Hackage version](https://img.shields.io/hackage/v/brittany.svg?label=Hackage)](https://hackage.haskell.org/package/brittany) [![Stackage version](https://www.stackage.org/package/brittany/badge/lts?label=Stackage)](https://www.stackage.org/package/brittany) [![Build Status](https://secure.travis-ci.org/lspitzner/brittany.svg?branch=master)](http://travis-ci.org/lspitzner/brittany)
haskell source code formatter haskell source code formatter
![Output sample](https://github.com/lspitzner/brittany/raw/master/brittany-sample.gif) ![Output sample](https://github.com/lspitzner/brittany/raw/master/brittany-sample.gif)
@ -31,7 +31,7 @@ require fixing:
other module elements (data-decls, classes, instances, etc.) other module elements (data-decls, classes, instances, etc.)
are not transformed in any way; this extends to e.g. **bindings inside class are not transformed in any way; this extends to e.g. **bindings inside class
instance definitions** - they **won't be touched** (yet). instance definitions** - they **won't be touched** (yet).
- By using `ghc-exactprint` as the parser, brittany supports full GHC - By using `ghc-exactprint` as the parser, brittany supports full GHC
including extensions, but **some of the less common syntactic elements including extensions, but **some of the less common syntactic elements
(even of 2010 haskell) are not handled**. (even of 2010 haskell) are not handled**.
- **There are some known issues regarding handling of in-source comments.** - **There are some known issues regarding handling of in-source comments.**
@ -48,7 +48,7 @@ log the size of the input, but _not_ the full input/output of requests.)
# Other usage notes # Other usage notes
- Supports GHC versions `8.0`, `8.2`, `8.4`, `8.6`, `8.8`. - Supports GHC versions `8.6`, `8.8`, `8.10`.
- included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15) - included in stackage with lts>=10.0 (or nightlies dating to >=2017-11-15)
- config (file) documentation is lacking. - config (file) documentation is lacking.
- some config values can not be configured via commandline yet. - some config values can not be configured via commandline yet.
@ -127,13 +127,13 @@ log the size of the input, but _not_ the full input/output of requests.)
- Default mode of operation: Transform a single module, from `stdin` to `stdout`. - Default mode of operation: Transform a single module, from `stdin` to `stdout`.
Can pass one or multiple files as input, and there is a flag to override them Can pass one or multiple files as input, and there is a flag to override them
in place instead of using `stdout` (since 0.9.0.0). So: in place instead of using `stdout` (since 0.9.0.0). So:
~~~~ .sh ~~~~ .sh
brittany # stdin -> stdout brittany # stdin -> stdout
brittany mysource.hs # ./mysource.hs -> stdout brittany mysource.hs # ./mysource.hs -> stdout
brittany --write-mode=inplace *.hs # apply formatting to all ./*.hs inplace brittany --write-mode=inplace *.hs # apply formatting to all ./*.hs inplace
~~~~ ~~~~
- For stdin/stdout usage it makes sense to enable certain syntactic extensions - For stdin/stdout usage it makes sense to enable certain syntactic extensions
by default, i.e. to add something like this to your by default, i.e. to add something like this to your
`~/.config/brittany/config.yaml` (execute `brittany` once to create default): `~/.config/brittany/config.yaml` (execute `brittany` once to create default):

View File

@ -91,10 +91,10 @@ library {
-fno-warn-redundant-constraints -fno-warn-redundant-constraints
} }
build-depends: build-depends:
{ base >=4.9 && <4.14 { base >=4.12 && <4.15
, ghc >=8.0.1 && <8.9 , ghc >=8.6.1 && <8.11
, ghc-paths >=0.1.0.9 && <0.2 , ghc-paths >=0.1.0.9 && <0.2
, ghc-exactprint >=0.5.8 && <0.6.3 , ghc-exactprint >=0.5.8 && <0.6.4
, transformers >=0.5.2.0 && <0.6 , transformers >=0.5.2.0 && <0.6
, containers >=0.5.7.1 && <0.7 , containers >=0.5.7.1 && <0.7
, mtl >=2.2.1 && <2.3 , mtl >=2.2.1 && <2.3
@ -110,7 +110,7 @@ library {
, aeson >=1.0.1.0 && <1.6 , aeson >=1.0.1.0 && <1.6
, extra >=1.4.10 && <1.8 , extra >=1.4.10 && <1.8
, uniplate >=1.6.12 && <1.7 , uniplate >=1.6.12 && <1.7
, strict >=0.3.2 && <0.4 , strict >=0.3.2 && <0.5
, monad-memo >=0.4.1 && <0.6 , monad-memo >=0.4.1 && <0.6
, unsafe >=0.0 && <0.1 , unsafe >=0.0 && <0.1
, safe >=0.3.9 && <0.4 , safe >=0.3.9 && <0.4
@ -118,7 +118,7 @@ library {
, semigroups >=0.18.2 && <0.20 , semigroups >=0.18.2 && <0.20
, cmdargs >=0.10.14 && <0.11 , cmdargs >=0.10.14 && <0.11
, czipwith >=1.0.1.0 && <1.1 , czipwith >=1.0.1.0 && <1.1
, ghc-boot-th >=8.0.1 && <8.9 , ghc-boot-th >=8.6.1 && <8.11
, filepath >=1.4.1.0 && <1.5 , filepath >=1.4.1.0 && <1.5
, random >= 1.1 && <1.2 , random >= 1.1 && <1.2
} }

View File

@ -473,13 +473,6 @@ foo n = case n of
bar n = case n of bar n = case n of
(-2, -2) -> (-2, -2) (-2, -2) -> (-2, -2)
#test issue 48 a
foo =
let a = b@1
cccc = ()
in foo
#test issue 48 b #test issue 48 b
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}

View File

@ -1409,14 +1409,6 @@ foo n = case n of
bar n = case n of bar n = case n of
(-2, -2) -> (-2, -2) (-2, -2) -> (-2, -2)
#test issue 48 a
foo =
let
a = b@1
cccc = ()
in foo
#test issue 48 b #test issue 48 b
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}

View File

@ -61,7 +61,12 @@ import GHC ( Located
) )
import RdrName ( RdrName(..) ) import RdrName ( RdrName(..) )
import SrcLoc ( SrcSpan ) import SrcLoc ( SrcSpan )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import Bag
#else
import HsSyn import HsSyn
#endif
import qualified DynFlags as GHC import qualified DynFlags as GHC
import qualified GHC.LanguageExtensions.Type as GHC import qualified GHC.LanguageExtensions.Type as GHC
@ -380,7 +385,11 @@ parsePrintModuleTests conf filename input = do
let inputStr = Text.unpack input let inputStr = Text.unpack input
parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
case parseResult of case parseResult of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
#else
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
#endif
Right (anns, parsedModule) -> runExceptT $ do Right (anns, parsedModule) -> runExceptT $ do
(inlineConf, perItemConf) <- (inlineConf, perItemConf) <-
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
@ -509,17 +518,10 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
_ -> return () _ -> return ()
getDeclBindingNames :: LHsDecl GhcPs -> [String] getDeclBindingNames :: LHsDecl GhcPs -> [String]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
getDeclBindingNames (L _ decl) = case decl of getDeclBindingNames (L _ decl) = case decl of
SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n) SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n] ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n]
_ -> [] _ -> []
#else
getDeclBindingNames (L _ decl) = case decl of
SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n]
_ -> []
#endif
-- Prints the information associated with the module annotation -- Prints the information associated with the module annotation
@ -577,26 +579,15 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
_sigHead :: Sig GhcPs -> String _sigHead :: Sig GhcPs -> String
_sigHead = \case _sigHead = \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
TypeSig _ names _ -> TypeSig _ names _ ->
#else
TypeSig names _ ->
#endif
"TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names) "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
_ -> "unknown sig" _ -> "unknown sig"
_bindHead :: HsBind GhcPs -> String _bindHead :: HsBind GhcPs -> String
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
_bindHead = \case _bindHead = \case
FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId) FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
PatBind _ _pat _ ([], []) -> "PatBind smth" PatBind _ _pat _ ([], []) -> "PatBind smth"
_ -> "unknown bind" _ -> "unknown bind"
#else
_bindHead = \case
FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
PatBind _pat _ _ _ ([], []) -> "PatBind smth"
_ -> "unknown bind"
#endif

View File

@ -229,15 +229,12 @@ deriving instance Data (CForwardOptions Identity)
deriving instance Data (CPreProcessorConfig Identity) deriving instance Data (CPreProcessorConfig Identity)
deriving instance Data (CConfig Identity) deriving instance Data (CConfig Identity)
#if MIN_VERSION_ghc(8,2,0)
-- these instances break on earlier ghcs
deriving instance Data (CDebugConfig Option) deriving instance Data (CDebugConfig Option)
deriving instance Data (CLayoutConfig Option) deriving instance Data (CLayoutConfig Option)
deriving instance Data (CErrorHandlingConfig Option) deriving instance Data (CErrorHandlingConfig Option)
deriving instance Data (CForwardOptions Option) deriving instance Data (CForwardOptions Option)
deriving instance Data (CPreProcessorConfig Option) deriving instance Data (CPreProcessorConfig Option)
deriving instance Data (CConfig Option) deriving instance Data (CConfig Option)
#endif
instance Semigroup.Semigroup (CDebugConfig Option) where instance Semigroup.Semigroup (CDebugConfig Option) where
(<>) = gmappend (<>) = gmappend
@ -356,4 +353,3 @@ deriveCZipWith ''CErrorHandlingConfig
deriveCZipWith ''CForwardOptions deriveCZipWith ''CForwardOptions
deriveCZipWith ''CPreProcessorConfig deriveCZipWith ''CPreProcessorConfig
deriveCZipWith ''CConfig deriveCZipWith ''CConfig

View File

@ -33,7 +33,14 @@ import qualified Lexer as GHC
import qualified StringBuffer as GHC import qualified StringBuffer as GHC
import qualified Outputable as GHC import qualified Outputable as GHC
import qualified CmdLineParser as GHC import qualified CmdLineParser as GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import Bag
#else
import HsSyn import HsSyn
#endif
import SrcLoc ( SrcSpan, Located ) import SrcLoc ( SrcSpan, Located )
@ -90,7 +97,11 @@ parseModuleWithCpp cpp opts args fp dynCheck =
++ show (warnings <&> warnExtractorCompat) ++ show (warnings <&> warnExtractorCompat)
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2 x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err)))
#else
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err) either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
#endif
(\(a, m) -> pure (a, m, x)) (\(a, m) -> pure (a, m, x))
$ ExactPrint.postParseTransform res opts $ ExactPrint.postParseTransform res opts
@ -123,7 +134,11 @@ parseModuleFromString args fp dynCheck str =
dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1 dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
case res of case res of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
#else
Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err
#endif
Right (a , m ) -> pure (a, m, dynCheckRes) Right (a , m ) -> pure (a, m, dynCheckRes)
@ -187,7 +202,7 @@ commentAnnFixTransformGlob ast = do
, ExactPrint.annsDP = assocs' , ExactPrint.annsDP = assocs'
} }
ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns
commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform () commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()
@ -197,17 +212,9 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul
genF = (\_ -> return ()) `SYB.extQ` exprF genF = (\_ -> return ()) `SYB.extQ` exprF
exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform () exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
exprF lexpr@(L _ expr) = case expr of exprF lexpr@(L _ expr) = case expr of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecordCon _ _ (HsRecFields fs@(_:_) Nothing) -> RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
#else
RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) ->
#endif
moveTrailingComments lexpr (List.last fs) moveTrailingComments lexpr (List.last fs)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecordUpd _ _e fs@(_:_) -> RecordUpd _ _e fs@(_:_) ->
#else
RecordUpd _e fs@(_:_) _cons _ _ _ ->
#endif
moveTrailingComments lexpr (List.last fs) moveTrailingComments lexpr (List.last fs)
_ -> return () _ -> return ()
@ -305,10 +312,5 @@ withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
in annsBalanced in annsBalanced
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
warnExtractorCompat :: GHC.Warn -> String warnExtractorCompat :: GHC.Warn -> String
warnExtractorCompat (GHC.Warn _ (L _ s)) = s warnExtractorCompat (GHC.Warn _ (L _ s)) = s
#else /* ghc-8.0 && ghc-8.2 */
warnExtractorCompat :: GenLocated l String -> String
warnExtractorCompat (L _ s) = s
#endif

View File

@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types
import RdrName ( RdrName(..) ) import RdrName ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import qualified GHC import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import BasicTypes import BasicTypes
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
@ -40,20 +44,11 @@ layoutDataDecl
-> LHsQTyVars GhcPs -> LHsQTyVars GhcPs
-> HsDataDefn GhcPs -> HsDataDefn GhcPs
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext
layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
#else
layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
#endif
-- newtype MyType a b = MyType .. -- newtype MyType a b = MyType ..
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
(L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) -> (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) ->
#else
HsDataDefn NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
(L _ (ConDeclH98 consName Nothing (Just (L _ [])) details _conDoc)) ->
#endif
docWrapNode ltycl $ do docWrapNode ltycl $ do
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
consNameStr <- lrdrNameToTextAnn consName consNameStr <- lrdrNameToTextAnn consName
@ -78,11 +73,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
-- data MyData a b -- data MyData a b
-- (zero constructors) -- (zero constructors)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs ->
#else
HsDataDefn DataType (L _ lhsContext) _ctype Nothing [] mDerivs ->
#endif
docWrapNode ltycl $ do docWrapNode ltycl $ do
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
@ -96,17 +87,9 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
-- data MyData = MyData .. -- data MyData = MyData ..
-- data MyData = MyData { .. } -- data MyData = MyData { .. }
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
#else
HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
#endif
case cons of case cons of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
(L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) -> (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) ->
#else
(L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) ->
#endif
docWrapNode ltycl $ do docWrapNode ltycl $ do
lhsContextDoc <- docSharedWrapper createContextDoc lhsContext lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
@ -262,18 +245,11 @@ createContextDoc (t1 : tR) = do
createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
createBndrDoc bs = do createBndrDoc bs = do
tyVarDocs <- bs `forM` \case tyVarDocs <- bs `forM` \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
(L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing) (L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
(L _ (KindedTyVar _ext lrdrName kind)) -> do (L _ (KindedTyVar _ext lrdrName kind)) -> do
#else
(L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do
#endif
d <- docSharedWrapper layoutType kind d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d) return $ (lrdrNameToText lrdrName, Just $ d)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
(L _ (XTyVarBndr ext)) -> absurdExt ext (L _ (XTyVarBndr ext)) -> absurdExt ext
#endif
docSeq docSeq
$ List.intersperse docSeparator $ List.intersperse docSeparator
$ tyVarDocs $ tyVarDocs
@ -293,7 +269,6 @@ createDerivingPar
:: HsDeriving GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered :: HsDeriving GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
createDerivingPar derivs mainDoc = do createDerivingPar derivs mainDoc = do
case derivs of case derivs of
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
(L _ []) -> mainDoc (L _ []) -> mainDoc
(L _ types) -> (L _ types) ->
docPar mainDoc docPar mainDoc
@ -302,38 +277,17 @@ createDerivingPar derivs mainDoc = do
$ docWrapNode derivs $ docWrapNode derivs
$ derivingClauseDoc $ derivingClauseDoc
<$> types <$> types
#else
Nothing -> mainDoc
Just types ->
docPar mainDoc
$ docEnsureIndent BrIndentRegular
$ derivingClauseDoc types
#endif
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered
#else
derivingClauseDoc :: Located [LHsSigType GhcPs] -> ToBriDocM BriDocNumbered
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext
derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of
#else
derivingClauseDoc types = case types of
#endif
(L _ []) -> docSeq [] (L _ []) -> docSeq []
(L _ ts) -> (L _ ts) ->
let let
tsLength = length ts tsLength = length ts
whenMoreThan1Type val = whenMoreThan1Type val =
if tsLength > 1 then docLitS val else docLitS "" if tsLength > 1 then docLitS val else docLitS ""
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
(lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
#else
(lhsStrategy, rhsStrategy) = (docEmpty, docEmpty)
#endif
in in
docSeq docSeq
[ docDeriving [ docDeriving
@ -344,24 +298,16 @@ derivingClauseDoc types = case types of
$ docSeq $ docSeq
$ List.intersperse docCommaSep $ List.intersperse docCommaSep
$ ts <&> \case $ ts <&> \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsIB _ t -> layoutType t HsIB _ t -> layoutType t
XHsImplicitBndrs x -> absurdExt x XHsImplicitBndrs x -> absurdExt x
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsIB _ t _ -> layoutType t
#else
HsIB _ t -> layoutType t
#endif
, whenMoreThan1Type ")" , whenMoreThan1Type ")"
, rhsStrategy , rhsStrategy
] ]
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.6 */
where where
strategyLeftRight = \case strategyLeftRight = \case
(L _ StockStrategy ) -> (docLitS " stock", docEmpty) (L _ StockStrategy ) -> (docLitS " stock", docEmpty)
(L _ AnyclassStrategy ) -> (docLitS " anyclass", docEmpty) (L _ AnyclassStrategy ) -> (docLitS " anyclass", docEmpty)
(L _ NewtypeStrategy ) -> (docLitS " newtype", docEmpty) (L _ NewtypeStrategy ) -> (docLitS " newtype", docEmpty)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
lVia@(L _ (ViaStrategy viaTypes) ) -> lVia@(L _ (ViaStrategy viaTypes) ) ->
( docEmpty ( docEmpty
, case viaTypes of , case viaTypes of
@ -372,8 +318,6 @@ derivingClauseDoc types = case types of
] ]
XHsImplicitBndrs ext -> absurdExt ext XHsImplicitBndrs ext -> absurdExt ext
) )
#endif
#endif
docDeriving :: ToBriDocM BriDocNumbered docDeriving :: ToBriDocM BriDocNumbered
docDeriving = docLitS "deriving" docDeriving = docLitS "deriving"
@ -491,12 +435,8 @@ createDetailsDoc consNameStr details = case details of
:: [LConDeclField GhcPs] :: [LConDeclField GhcPs]
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)] -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
mkFieldDocs = fmap $ \lField -> case lField of mkFieldDocs = fmap $ \lField -> case lField of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t
L _ (XConDeclField x) -> absurdExt x L _ (XConDeclField x) -> absurdExt x
#else
L _ (ConDeclField names t _) -> createNamesAndTypeDoc lField names t
#endif
createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered) createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
createForallDoc [] = Nothing createForallDoc [] = Nothing
@ -515,12 +455,8 @@ createNamesAndTypeDoc lField names t =
$ List.intersperse docCommaSep $ List.intersperse docCommaSep
$ names $ names
<&> \case <&> \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
L _ (XFieldOcc x) -> absurdExt x L _ (XFieldOcc x) -> absurdExt x
L _ (FieldOcc _ fieldName) -> L _ (FieldOcc _ fieldName) ->
#else
L _ (FieldOcc fieldName _) ->
#endif
docLit =<< lrdrNameToTextAnn fieldName docLit =<< lrdrNameToTextAnn fieldName
] ]
, docWrapNodeRest lField $ layoutType t , docWrapNodeRest lField $ layoutType t

View File

@ -37,8 +37,11 @@ import GHC ( runGhc
) )
import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc ) import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import qualified FastString import qualified FastString
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.Extension (NoExtField (..))
#else
import HsSyn import HsSyn
#if MIN_VERSION_ghc(8,6,0)
import HsExtension (NoExt (..)) import HsExtension (NoExt (..))
#endif #endif
import Name import Name
@ -46,9 +49,7 @@ import BasicTypes ( InlinePragma(..)
, Activation(..) , Activation(..)
, InlineSpec(..) , InlineSpec(..)
, RuleMatchInfo(..) , RuleMatchInfo(..)
#if MIN_VERSION_ghc(8,2,0)
, LexicalFixity(..) , LexicalFixity(..)
#endif
) )
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
@ -64,7 +65,6 @@ import Data.Char (isUpper)
layoutDecl :: ToBriDoc HsDecl layoutDecl :: ToBriDoc HsDecl
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
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
@ -76,18 +76,6 @@ layoutDecl d@(L loc decl) = case decl of
InstD _ (ClsInstD _ inst) -> InstD _ (ClsInstD _ inst) ->
withTransformedAnns d $ layoutClsInst (L loc inst) withTransformedAnns d $ layoutClsInst (L loc inst)
_ -> briDocByExactNoComment d _ -> briDocByExactNoComment d
#else
layoutDecl d@(L loc decl) = case decl of
SigD sig -> withTransformedAnns d $ layoutSig (L loc sig)
ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
Left ns -> docLines $ return <$> ns
Right n -> return n
TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl)
InstD (TyFamInstD tfid) ->
withTransformedAnns d $ layoutTyFamInstDecl False d tfid
InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst)
_ -> briDocByExactNoComment d
#endif
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Sig -- Sig
@ -95,18 +83,8 @@ layoutDecl d@(L loc decl) = case decl of
layoutSig :: ToBriDoc Sig layoutSig :: ToBriDoc Sig
layoutSig lsig@(L _loc sig) = case sig of layoutSig lsig@(L _loc sig) = case sig of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType Nothing names typ TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType Nothing names typ
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType Nothing names typ
#else /* ghc-8.0 */
TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType Nothing names typ
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) -> InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->
#else
InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->
#endif
docWrapNode lsig $ do docWrapNode lsig $ do
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
specStr <- specStringCompat lsig spec specStr <- specStringCompat lsig spec
@ -123,20 +101,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 " #-}"
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType Nothing names typ
#else /* ghc-8.0 */
ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ
#endif
#if MIN_VERSION_ghc(8,6,0)
PatSynSig _ names (HsIB _ typ) -> layoutNamesAndType (Just "pattern") names typ PatSynSig _ names (HsIB _ typ) -> layoutNamesAndType (Just "pattern") names typ
#elif MIN_VERSION_ghc(8,2,0)
PatSynSig names (HsIB _ typ _) -> layoutNamesAndType (Just "pattern") names typ
#else
PatSynSig name (HsIB _ typ) -> layoutNamesAndType (Just "pattern") [name] typ
#endif
_ -> briDocByExactNoComment lsig -- TODO _ -> briDocByExactNoComment lsig -- TODO
where where
layoutNamesAndType mKeyword names typ = docWrapNode lsig $ do layoutNamesAndType mKeyword names typ = docWrapNode lsig $ do
@ -170,32 +136,16 @@ layoutSig lsig@(L _loc sig) = case sig of
specStringCompat specStringCompat
:: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String
#if MIN_VERSION_ghc(8,4,0)
specStringCompat ast = \case specStringCompat ast = \case
NoUserInline -> mTell [ErrorUnknownNode "NoUserInline" ast] $> "" NoUserInline -> mTell [ErrorUnknownNode "NoUserInline" ast] $> ""
Inline -> pure "INLINE " Inline -> pure "INLINE "
Inlinable -> pure "INLINABLE " Inlinable -> pure "INLINABLE "
NoInline -> pure "NOINLINE " 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 :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BodyStmt _ body _ _ -> layoutExpr body BodyStmt _ body _ _ -> layoutExpr body
#else
BodyStmt body _ _ _ -> layoutExpr body
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BindStmt _ lPat expr _ _ -> do BindStmt _ lPat expr _ _ -> do
#else
BindStmt lPat expr _ _ _ -> do
#endif
patDoc <- docSharedWrapper layoutPat lPat patDoc <- docSharedWrapper layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docCols ColBindStmt docCols ColBindStmt
@ -214,11 +164,7 @@ layoutBind
(HsBindLR GhcPs GhcPs) (HsBindLR GhcPs GhcPs)
(Either [BriDocNumbered] BriDocNumbered) (Either [BriDocNumbered] BriDocNumbered)
layoutBind lbind@(L _ bind) = case bind of layoutBind lbind@(L _ bind) = case bind of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do
#else
FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do
#endif
idStr <- lrdrNameToTextAnn fId idStr <- lrdrNameToTextAnn fId
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
funcPatDocs <- funcPatDocs <-
@ -227,11 +173,7 @@ layoutBind lbind@(L _ bind) = case bind of
$ layoutPatternBind (Just idStr) binderDoc $ layoutPatternBind (Just idStr) binderDoc
`mapM` matches `mapM` matches
return $ Left $ funcPatDocs return $ Left $ funcPatDocs
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
PatBind _ pat (GRHSs _ grhss whereBinds) ([], []) -> do PatBind _ pat (GRHSs _ grhss whereBinds) ([], []) -> do
#else
PatBind pat (GRHSs grhss whereBinds) _ _ ([], []) -> do
#endif
patDocs <- colsWrapPat =<< layoutPat pat patDocs <- colsWrapPat =<< layoutPat pat
clauseDocs <- layoutGrhs `mapM` grhss clauseDocs <- layoutGrhs `mapM` grhss
mWhereDocs <- layoutLocalBinds whereBinds mWhereDocs <- layoutLocalBinds whereBinds
@ -246,10 +188,8 @@ layoutBind lbind@(L _ bind) = case bind of
hasComments hasComments
#if MIN_VERSION_ghc(8,8,0) #if MIN_VERSION_ghc(8,8,0)
PatSynBind _ (PSB _ patID lpat rpat dir) -> do PatSynBind _ (PSB _ patID lpat rpat dir) -> do
#elif MIN_VERSION_ghc(8,6,0)
PatSynBind _ (PSB _ patID lpat rpat dir) -> do
#else #else
PatSynBind (PSB patID _ lpat rpat dir) -> do PatSynBind _ (PSB _ patID lpat rpat dir) -> do
#endif #endif
fmap Right $ docWrapNode lbind $ layoutPatSynBind patID fmap Right $ docWrapNode lbind $ layoutPatSynBind patID
lpat lpat
@ -258,14 +198,9 @@ layoutBind lbind@(L _ bind) = case bind of
_ -> Right <$> unknownNodeError "" lbind _ -> Right <$> unknownNodeError "" lbind
layoutIPBind :: ToBriDoc IPBind layoutIPBind :: ToBriDoc IPBind
layoutIPBind lipbind@(L _ bind) = case bind of layoutIPBind lipbind@(L _ bind) = case bind of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
XIPBind{} -> unknownNodeError "XIPBind" lipbind XIPBind{} -> unknownNodeError "XIPBind" lipbind
IPBind _ (Right _) _ -> error "brittany internal error: IPBind Right" IPBind _ (Right _) _ -> error "brittany internal error: IPBind Right"
IPBind _ (Left (L _ (HsIPName name))) expr -> do IPBind _ (Left (L _ (HsIPName name))) expr -> do
#else
IPBind (Right _) _ -> error "brittany internal error: IPBind Right"
IPBind (Left (L _ (HsIPName name))) expr -> do
#endif
ipName <- docLit $ Text.pack $ '?' : FastString.unpackFS name ipName <- docLit $ Text.pack $ '?' : FastString.unpackFS name
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
exprDoc <- layoutExpr expr exprDoc <- layoutExpr expr
@ -287,11 +222,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
-- 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{})) ->
-- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x -- Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsValBinds _ (ValBinds _ bindlrs sigs) -> do HsValBinds _ (ValBinds _ bindlrs sigs) -> do
#else
HsValBinds (ValBindsIn bindlrs sigs) -> do
#endif
let unordered = let unordered =
[ BagBind b | b <- Data.Foldable.toList bindlrs ] [ BagBind b | b <- Data.Foldable.toList bindlrs ]
++ [ BagSig s | s <- sigs ] ++ [ BagSig s | s <- sigs ]
@ -300,23 +231,12 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
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
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
-- x@(HsValBinds (ValBindsOut _binds _lsigs)) -> -- x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR" HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR" XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR"
#else
x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
-- i _think_ this case never occurs in non-processed ast
Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"
(L noSrcSpan x)
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
x@(HsIPBinds _ XHsIPBinds{}) -> x@(HsIPBinds _ XHsIPBinds{}) ->
Just . (: []) <$> unknownNodeError "XHsIPBinds" (L noSrcSpan x) Just . (: []) <$> unknownNodeError "XHsIPBinds" (L noSrcSpan x)
HsIPBinds _ (IPBinds _ bb) -> HsIPBinds _ (IPBinds _ bb) ->
#else
HsIPBinds (IPBinds bb _) ->
#endif
Just <$> mapM layoutIPBind bb Just <$> mapM layoutIPBind bb
EmptyLocalBinds{} -> return $ Nothing EmptyLocalBinds{} -> return $ Nothing
@ -325,17 +245,11 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
layoutGrhs layoutGrhs
:: LGRHS GhcPs (LHsExpr GhcPs) :: LGRHS GhcPs (LHsExpr GhcPs)
-> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs) -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do
#else
layoutGrhs lgrhs@(L _ (GRHS guards body)) = do
#endif
guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards
bodyDoc <- layoutExpr body bodyDoc <- layoutExpr body
return (guardDocs, bodyDoc, body) return (guardDocs, bodyDoc, body)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS" layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS"
#endif
layoutPatternBind layoutPatternBind
:: Maybe Text :: Maybe Text
@ -344,23 +258,11 @@ layoutPatternBind
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutPatternBind funId binderDoc lmatch@(L _ match) = do layoutPatternBind funId binderDoc lmatch@(L _ match) = do
let pats = m_pats match let pats = m_pats match
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let (GRHSs _ grhss whereBinds) = m_grhss match let (GRHSs _ grhss whereBinds) = m_grhss match
#else
let (GRHSs grhss whereBinds) = m_grhss match
#endif
patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
let isInfix = isInfixMatch match let isInfix = isInfixMatch match
mIdStr <- case match of mIdStr <- case match of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
Match _ (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId Match _ (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId
#elif MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
Match (FunRhs matchId _ _) _ _ -> Just <$> lrdrNameToTextAnn matchId
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.4 */
Match (FunRhs matchId _ _) _ _ _ -> Just <$> lrdrNameToTextAnn matchId
#else
Match (FunBindMatch matchId _) _ _ _ -> Just <$> lrdrNameToTextAnn matchId
#endif
_ -> pure Nothing _ -> pure Nothing
let mIdStr' = fixPatternBindIdentifier match <$> mIdStr let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of
@ -403,7 +305,6 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
mWhereArg mWhereArg
hasComments hasComments
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 && ghc-8.4 */
fixPatternBindIdentifier fixPatternBindIdentifier
:: Match GhcPs (LHsExpr GhcPs) -> Text -> Text :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
fixPatternBindIdentifier match idStr = go $ m_ctxt match fixPatternBindIdentifier match idStr = go $ m_ctxt match
@ -421,10 +322,6 @@ fixPatternBindIdentifier match idStr = go $ m_ctxt match
(ParStmtCtxt ctx1) -> goInner ctx1 (ParStmtCtxt ctx1) -> goInner ctx1
(TransStmtCtxt ctx1) -> goInner ctx1 (TransStmtCtxt ctx1) -> goInner ctx1
_ -> idStr _ -> idStr
#else /* ghc-8.0 */
fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
fixPatternBindIdentifier _ x = x
#endif
layoutPatternBindFinal layoutPatternBindFinal
:: Maybe Text :: Maybe Text
@ -786,28 +683,16 @@ layoutLPatSyn
:: Located (IdP GhcPs) :: Located (IdP GhcPs)
-> HsPatSynDetails (Located (IdP GhcPs)) -> HsPatSynDetails (Located (IdP GhcPs))
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,4,0)
layoutLPatSyn name (PrefixCon vars) = do layoutLPatSyn name (PrefixCon vars) = do
#else
layoutLPatSyn name (PrefixPatSyn vars) = do
#endif
docName <- lrdrNameToTextAnn name docName <- lrdrNameToTextAnn name
names <- mapM lrdrNameToTextAnn vars names <- mapM lrdrNameToTextAnn vars
docSeq . fmap appSep $ docLit docName : (docLit <$> names) docSeq . fmap appSep $ docLit docName : (docLit <$> names)
#if MIN_VERSION_ghc(8,4,0)
layoutLPatSyn name (InfixCon left right) = do layoutLPatSyn name (InfixCon left right) = do
#else
layoutLPatSyn name (InfixPatSyn left right) = do
#endif
leftDoc <- lrdrNameToTextAnn left leftDoc <- lrdrNameToTextAnn left
docName <- lrdrNameToTextAnn name docName <- lrdrNameToTextAnn name
rightDoc <- lrdrNameToTextAnn right rightDoc <- lrdrNameToTextAnn right
docSeq . fmap (appSep . docLit) $ [leftDoc, docName, rightDoc] docSeq . fmap (appSep . docLit) $ [leftDoc, docName, rightDoc]
#if MIN_VERSION_ghc(8,4,0)
layoutLPatSyn name (RecCon recArgs) = do layoutLPatSyn name (RecCon recArgs) = do
#else
layoutLPatSyn name (RecordPatSyn recArgs) = do
#endif
docName <- lrdrNameToTextAnn name docName <- lrdrNameToTextAnn name
args <- mapM (lrdrNameToTextAnn . recordPatSynSelectorId) recArgs args <- mapM (lrdrNameToTextAnn . recordPatSynSelectorId) recArgs
docSeq . fmap docLit docSeq . fmap docLit
@ -819,11 +704,7 @@ layoutLPatSyn name (RecordPatSyn recArgs) = do
-- pattern synonyms -- pattern synonyms
layoutPatSynWhere :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [ToBriDocM 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)
ExplicitBidirectional (MG _ (L _ lbinds) _) -> do ExplicitBidirectional (MG _ (L _ lbinds) _) -> do
#else
ExplicitBidirectional (MG (L _ lbinds) _ _ _) -> do
#endif
binderDoc <- docLit $ Text.pack "=" binderDoc <- docLit $ Text.pack "="
Just <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds Just <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds
_ -> pure Nothing _ -> pure Nothing
@ -834,24 +715,10 @@ layoutPatSynWhere hs = case hs of
layoutTyCl :: ToBriDoc TyClDecl layoutTyCl :: ToBriDoc TyClDecl
layoutTyCl ltycl@(L _loc tycl) = case tycl of layoutTyCl ltycl@(L _loc tycl) = case tycl of
#if MIN_VERSION_ghc(8,6,0)
SynDecl _ name vars fixity typ -> do SynDecl _ name vars fixity typ -> do
let isInfix = case fixity of let isInfix = case fixity of
Prefix -> False Prefix -> False
Infix -> True Infix -> True
#elif MIN_VERSION_ghc(8,2,0)
SynDecl name vars fixity typ _ -> do
let isInfix = case fixity of
Prefix -> False
Infix -> True
#else
SynDecl name vars typ _ -> do
nameStr <- lrdrNameToTextAnn name
let isInfixTypeOp = case Text.uncons nameStr of
Nothing -> False
Just (c, _) -> not (c == '(' || isUpper c)
isInfix <- (isInfixTypeOp ||) <$> hasAnnKeyword name AnnBackquote
#endif
-- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP
-- let parenWrapper = if hasTrailingParen -- let parenWrapper = if hasTrailingParen
-- then appSep . docWrapNodeRest ltycl -- then appSep . docWrapNodeRest ltycl
@ -859,13 +726,7 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
let wrapNodeRest = docWrapNodeRest ltycl let wrapNodeRest = docWrapNodeRest ltycl
docWrapNodePrior ltycl docWrapNodePrior ltycl
$ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ
#if MIN_VERSION_ghc(8,6,0)
DataDecl _ext name tyVars _ dataDefn -> DataDecl _ext name tyVars _ dataDefn ->
#elif MIN_VERSION_ghc(8,2,0)
DataDecl name tyVars _ dataDefn _ _ ->
#else
DataDecl name tyVars dataDefn _ _ ->
#endif
layoutDataDecl ltycl name tyVars dataDefn layoutDataDecl ltycl name tyVars dataDefn
_ -> briDocByExactNoComment ltycl _ -> briDocByExactNoComment ltycl
@ -913,19 +774,11 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
docWrapNodePrior lbndr $ case bndr of docWrapNodePrior lbndr $ case bndr of
#if MIN_VERSION_ghc(8,6,0) /* 8.6 */
XTyVarBndr{} -> error "brittany internal error: XTyVarBndr" XTyVarBndr{} -> error "brittany internal error: XTyVarBndr"
UserTyVar _ name -> do UserTyVar _ name -> do
#else /* 8.0 8.2 8.4 */
UserTyVar name -> do
#endif
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr] docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
#if MIN_VERSION_ghc(8,6,0) /* 8.6 */
KindedTyVar _ name kind -> do KindedTyVar _ name kind -> do
#else /* 8.0 8.2 8.4 */
KindedTyVar name kind -> do
#endif
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
docSeq docSeq
$ [ docSeparator | needsSep ] $ [ docSeparator | needsSep ]
@ -956,22 +809,10 @@ layoutTyFamInstDecl inClass outerNode tfid = do
-- bndrsMay isJust e.g. with -- bndrsMay isJust e.g. with
-- type instance forall a . MyType (Maybe a) = Either () a -- type instance forall a . MyType (Maybe a) = Either () a
innerNode = outerNode innerNode = outerNode
#elif MIN_VERSION_ghc(8,6,0) #else
FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid
bndrsMay = Nothing bndrsMay = Nothing
innerNode = outerNode innerNode = outerNode
#elif MIN_VERSION_ghc(8,4,0)
FamEqn name pats _fixity typ = hsib_body $ tfid_eqn tfid
bndrsMay = Nothing
innerNode = outerNode
#elif MIN_VERSION_ghc(8,2,0)
innerNode@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid
bndrsMay = Nothing
pats = hsib_body boundPats
#else
innerNode@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid
bndrsMay = Nothing
pats = hsib_body boundPats
#endif #endif
docWrapNodePrior outerNode $ do docWrapNodePrior outerNode $ do
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
@ -1040,18 +881,18 @@ layoutClsInst lcid@(L _ cid) = docLines
] ]
where where
layoutInstanceHead :: ToBriDocM BriDocNumbered layoutInstanceHead :: ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,6,0) /* 8.6 */ #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
layoutInstanceHead = layoutInstanceHead =
briDocByExactNoComment briDocByExactNoComment
$ InstD NoExt $ InstD NoExtField
. ClsInstD NoExt . ClsInstD NoExtField
. removeChildren . removeChildren
<$> lcid <$> lcid
#else #else
layoutInstanceHead = layoutInstanceHead =
briDocByExactNoComment briDocByExactNoComment
$ InstD $ InstD NoExt
. ClsInstD . ClsInstD NoExt
. removeChildren . removeChildren
<$> lcid <$> lcid
#endif #endif

View File

@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) ) import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes
@ -40,67 +44,29 @@ layoutExpr lexpr@(L _ expr) = do
.> confUnpack .> confUnpack
let allowFreeIndent = indentPolicy == IndentPolicyFree let allowFreeIndent = indentPolicy == IndentPolicyFree
docWrapNode lexpr $ case expr of docWrapNode lexpr $ case expr of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsVar _ vname -> do HsVar _ vname -> do
#else
HsVar vname -> do
#endif
docLit =<< lrdrNameToTextAnn vname docLit =<< lrdrNameToTextAnn vname
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsUnboundVar _ var -> case var of HsUnboundVar _ var -> case var of
#else
HsUnboundVar var -> case var of
#endif
OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname
TrueExprHole oname -> docLit $ Text.pack $ occNameString oname TrueExprHole oname -> docLit $ Text.pack $ occNameString oname
HsRecFld{} -> do HsRecFld{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsRecFld" lexpr briDocByExactInlineOnly "HsRecFld" lexpr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsOverLabel _ext _reboundFromLabel name -> HsOverLabel _ext _reboundFromLabel name ->
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
HsOverLabel _reboundFromLabel name ->
#else /* ghc-8.0 */
HsOverLabel name ->
#endif
let label = FastString.unpackFS name let label = FastString.unpackFS name
in docLit . Text.pack $ '#' : label in docLit . Text.pack $ '#' : label
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsIPVar _ext (HsIPName name) -> HsIPVar _ext (HsIPName name) ->
#else
HsIPVar (HsIPName name) ->
#endif
let label = FastString.unpackFS name let label = FastString.unpackFS name
in docLit . Text.pack $ '?' : label in docLit . Text.pack $ '?' : label
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsOverLit _ olit -> do HsOverLit _ olit -> do
#else
HsOverLit olit -> do
#endif
allocateNode $ overLitValBriDoc $ ol_val olit allocateNode $ overLitValBriDoc $ ol_val olit
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLit _ lit -> do HsLit _ lit -> do
#else
HsLit lit -> do
#endif
allocateNode $ litBriDoc lit allocateNode $ litBriDoc lit
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _) HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _)
#else
HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)
#endif
| pats <- m_pats match | pats <- m_pats match
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
, GRHSs _ [lgrhs] llocals <- m_grhss match , GRHSs _ [lgrhs] llocals <- m_grhss match
#else
, GRHSs [lgrhs] llocals <- m_grhss match
#endif
, L _ EmptyLocalBinds {} <- llocals , L _ EmptyLocalBinds {} <- llocals
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
, L _ (GRHS _ [] body) <- lgrhs , L _ (GRHS _ [] body) <- lgrhs
#else
, L _ (GRHS [] body) <- lgrhs
#endif
-> do -> do
patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) -> patDocs <- zip (True : repeat False) pats `forM` \(isFirst, p) ->
fmap return $ do fmap return $ do
@ -166,52 +132,26 @@ layoutExpr lexpr@(L _ expr) = do
] ]
HsLam{} -> HsLam{} ->
unknownNodeError "HsLam too complex" lexpr unknownNodeError "HsLam too complex" lexpr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLamCase _ XMatchGroup{} -> HsLamCase _ XMatchGroup{} ->
error "brittany internal error: HsLamCase XMatchGroup" error "brittany internal error: HsLamCase XMatchGroup"
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLamCase _ (MG _ (L _ []) _) -> do HsLamCase _ (MG _ (L _ []) _) -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/
HsLamCase (MG (L _ []) _ _ _) -> do
#else /* ghc-8.0 */
HsLamCase _ (MG (L _ []) _ _ _) -> do
#endif
docSetParSpacing $ docAddBaseY BrIndentRegular $ docSetParSpacing $ docAddBaseY BrIndentRegular $
(docLit $ Text.pack "\\case {}") (docLit $ Text.pack "\\case {}")
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/
HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do
#else /* ghc-8.0 */
HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
#endif
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
funcPatDocs <- docWrapNode lmatches funcPatDocs <- docWrapNode lmatches
$ layoutPatternBind Nothing binderDoc `mapM` matches $ layoutPatternBind Nothing binderDoc `mapM` matches
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "\\case") (docLit $ Text.pack "\\case")
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsApp _ exp1@(L _ HsApp{}) exp2 -> do HsApp _ exp1@(L _ HsApp{}) exp2 -> do
#else
HsApp exp1@(L _ HsApp{}) exp2 -> do
#endif
let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs]) let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
gather list = \case gather list = \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
L _ (HsApp _ l r) -> gather (r:list) l L _ (HsApp _ l r) -> gather (r:list) l
#else
L _ (HsApp l r) -> gather (r:list) l
#endif
x -> (x, list) x -> (x, list)
let (headE, paramEs) = gather [exp2] exp1 let (headE, paramEs) = gather [exp2] exp1
let colsOrSequence = case headE of let colsOrSequence = case headE of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
L _ (HsVar _ (L _ (Unqual occname))) -> L _ (HsVar _ (L _ (Unqual occname))) ->
#else
L _ (HsVar (L _ (Unqual occname))) ->
#endif
docCols (ColApp $ Text.pack $ occNameString occname) docCols (ColApp $ Text.pack $ occNameString occname)
_ -> docSeq _ -> docSeq
headDoc <- docSharedWrapper layoutExpr headE headDoc <- docSharedWrapper layoutExpr headE
@ -257,11 +197,7 @@ layoutExpr lexpr@(L _ expr) = do
( docNonBottomSpacing ( docNonBottomSpacing
$ docLines paramDocs $ docLines paramDocs
) )
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsApp _ exp1 exp2 -> do HsApp _ exp1 exp2 -> do
#else
HsApp exp1 exp2 -> do
#endif
-- TODO: if expDoc1 is some literal, we may want to create a docCols here. -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
expDoc2 <- docSharedWrapper layoutExpr exp2 expDoc2 <- docSharedWrapper layoutExpr exp2
@ -303,14 +239,10 @@ layoutExpr lexpr@(L _ expr) = do
HsAppType _ _ XHsWildCardBndrs{} -> HsAppType _ _ XHsWildCardBndrs{} ->
error "brittany internal error: HsAppType XHsWildCardBndrs" error "brittany internal error: HsAppType XHsWildCardBndrs"
HsAppType _ exp1 (HsWC _ ty1) -> do HsAppType _ exp1 (HsWC _ ty1) -> do
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #else
HsAppType XHsWildCardBndrs{} _ -> HsAppType XHsWildCardBndrs{} _ ->
error "brittany internal error: HsAppType XHsWildCardBndrs" error "brittany internal error: HsAppType XHsWildCardBndrs"
HsAppType (HsWC _ ty1) exp1 -> do HsAppType (HsWC _ ty1) exp1 -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
HsAppType exp1 (HsWC _ ty1) -> do
#else /* ghc-8.0 */
HsAppType exp1 (HsWC _ _ ty1) -> do
#endif #endif
t <- docSharedWrapper layoutType ty1 t <- docSharedWrapper layoutType ty1
e <- docSharedWrapper layoutExpr exp1 e <- docSharedWrapper layoutExpr exp1
@ -325,23 +257,10 @@ layoutExpr lexpr@(L _ expr) = do
e e
(docSeq [docLit $ Text.pack "@", t ]) (docSeq [docLit $ Text.pack "@", t ])
] ]
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
HsAppTypeOut{} -> do
-- TODO
briDocByExactInlineOnly "HsAppTypeOut{}" lexpr
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do
#else
OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do
#endif
let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)]) let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])
gather opExprList = \case gather opExprList = \case
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
(L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1): opExprList) l1 (L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1): opExprList) l1
#else
(L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1
#endif
final -> (final, opExprList) final -> (final, opExprList)
(leftOperand, appList) = gather [] expLeft (leftOperand, appList) = gather [] expLeft
leftOperandDoc <- docSharedWrapper layoutExpr leftOperand leftOperandDoc <- docSharedWrapper layoutExpr leftOperand
@ -355,19 +274,11 @@ layoutExpr lexpr@(L _ expr) = do
hasComLeft <- hasAnyCommentsConnected expLeft hasComLeft <- hasAnyCommentsConnected expLeft
hasComOp <- hasAnyCommentsConnected expOp hasComOp <- hasAnyCommentsConnected expOp
pure $ not hasComLeft && not hasComOp pure $ not hasComLeft && not hasComOp
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let allowPar = case (expOp, expRight) of let allowPar = case (expOp, expRight) of
(L _ (HsVar _ (L _ (Unqual occname))), _) (L _ (HsVar _ (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
_ -> True _ -> True
#else
let allowPar = case (expOp, expRight) of
(L _ (HsVar (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True
#endif
runFilteredAlternative $ do runFilteredAlternative $ do
-- > one + two + three -- > one + two + three
-- or -- or
@ -405,27 +316,15 @@ layoutExpr lexpr@(L _ expr) = do
$ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
) )
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
OpApp _ expLeft expOp expRight -> do OpApp _ expLeft expOp expRight -> do
#else
OpApp expLeft expOp _ expRight -> do
#endif
expDocLeft <- docSharedWrapper layoutExpr expLeft expDocLeft <- docSharedWrapper layoutExpr expLeft
expDocOp <- docSharedWrapper layoutExpr expOp expDocOp <- docSharedWrapper layoutExpr expOp
expDocRight <- docSharedWrapper layoutExpr expRight expDocRight <- docSharedWrapper layoutExpr expRight
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let allowPar = case (expOp, expRight) of let allowPar = case (expOp, expRight) of
(L _ (HsVar _ (L _ (Unqual occname))), _) (L _ (HsVar _ (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True | occNameString occname == "$" -> True
(_, L _ (HsApp _ _ (L _ HsVar{}))) -> False (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
_ -> True _ -> True
#else
let allowPar = case (expOp, expRight) of
(L _ (HsVar (L _ (Unqual occname))), _)
| occNameString occname == "$" -> True
(_, L _ (HsApp _ (L _ HsVar{}))) -> False
_ -> True
#endif
let leftIsDoBlock = case expLeft of let leftIsDoBlock = case expLeft of
L _ HsDo{} -> True L _ HsDo{} -> True
_ -> False _ -> False
@ -471,20 +370,12 @@ layoutExpr lexpr@(L _ expr) = do
then docLines [expDocLeft, expDocOpAndRight] then docLines [expDocLeft, expDocOpAndRight]
else docAddBaseY BrIndentRegular else docAddBaseY BrIndentRegular
$ docPar expDocLeft expDocOpAndRight $ docPar expDocLeft expDocOpAndRight
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
NegApp _ op _ -> do NegApp _ op _ -> do
#else
NegApp op _ -> do
#endif
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq [ docLit $ Text.pack "-" docSeq [ docLit $ Text.pack "-"
, opDoc , opDoc
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsPar _ innerExp -> do HsPar _ innerExp -> do
#else
HsPar innerExp -> do
#endif
innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp
docAlt docAlt
[ docSeq [ docSeq
@ -500,36 +391,25 @@ layoutExpr lexpr@(L _ expr) = do
, docLit $ Text.pack ")" , docLit $ Text.pack ")"
] ]
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
SectionL _ left op -> do -- TODO: add to testsuite SectionL _ left op -> do -- TODO: add to testsuite
#else
SectionL left op -> do -- TODO: add to testsuite
#endif
leftDoc <- docSharedWrapper layoutExpr left leftDoc <- docSharedWrapper layoutExpr left
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
docSeq [leftDoc, docSeparator, opDoc] docSeq [leftDoc, docSeparator, opDoc]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
SectionR _ op right -> do -- TODO: add to testsuite SectionR _ op right -> do -- TODO: add to testsuite
#else
SectionR op right -> do -- TODO: add to testsuite
#endif
opDoc <- docSharedWrapper layoutExpr op opDoc <- docSharedWrapper layoutExpr op
rightDoc <- docSharedWrapper layoutExpr right rightDoc <- docSharedWrapper layoutExpr right
docSeq [opDoc, docSeparator, rightDoc] docSeq [opDoc, docSeparator, rightDoc]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
ExplicitTuple _ args boxity -> do ExplicitTuple _ args boxity -> do
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExtField)) -> (arg, Nothing)
(L _ XTupArg{}) -> error "brittany internal error: XTupArg"
#else #else
ExplicitTuple args boxity -> do
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let argExprs = args <&> \arg -> case arg of let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e); (L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExt)) -> (arg, Nothing) (L _ (Missing NoExt)) -> (arg, Nothing)
(L _ XTupArg{}) -> error "brittany internal error: XTupArg" (L _ XTupArg{}) -> error "brittany internal error: XTupArg"
#else
let argExprs = args <&> \arg -> case arg of
(L _ (Present e)) -> (arg, Just e);
(L _ (Missing PlaceHolder)) -> (arg, Nothing)
#endif #endif
argDocs <- forM argExprs argDocs <- forM argExprs
$ docSharedWrapper $ docSharedWrapper
@ -575,15 +455,9 @@ layoutExpr lexpr@(L _ expr) = do
lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
end = closeLit end = closeLit
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsCase _ _ XMatchGroup{} -> HsCase _ _ XMatchGroup{} ->
error "brittany internal error: HsCase XMatchGroup" error "brittany internal error: HsCase XMatchGroup"
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsCase _ cExp (MG _ (L _ []) _) -> do HsCase _ cExp (MG _ (L _ []) _) -> do
#else
HsCase cExp (MG (L _ []) _ _ _) -> do
#endif
cExpDoc <- docSharedWrapper layoutExpr cExp cExpDoc <- docSharedWrapper layoutExpr cExp
docAlt docAlt
[ docAddBaseY BrIndentRegular [ docAddBaseY BrIndentRegular
@ -598,11 +472,7 @@ layoutExpr lexpr@(L _ expr) = do
) )
(docLit $ Text.pack "of {}") (docLit $ Text.pack "of {}")
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do
#else
HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
#endif
cExpDoc <- docSharedWrapper layoutExpr cExp cExpDoc <- docSharedWrapper layoutExpr cExp
binderDoc <- docLit $ Text.pack "->" binderDoc <- docLit $ Text.pack "->"
funcPatDocs <- docWrapNode lmatches funcPatDocs <- docWrapNode lmatches
@ -626,11 +496,7 @@ layoutExpr lexpr@(L _ expr) = do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
) )
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsIf _ _ ifExpr thenExpr elseExpr -> do HsIf _ _ ifExpr thenExpr elseExpr -> do
#else
HsIf _ ifExpr thenExpr elseExpr -> do
#endif
ifExprDoc <- docSharedWrapper layoutExpr ifExpr ifExprDoc <- docSharedWrapper layoutExpr ifExpr
thenExprDoc <- docSharedWrapper layoutExpr thenExpr thenExprDoc <- docSharedWrapper layoutExpr thenExpr
elseExprDoc <- docSharedWrapper layoutExpr elseExpr elseExprDoc <- docSharedWrapper layoutExpr elseExpr
@ -750,11 +616,7 @@ layoutExpr lexpr@(L _ expr) = do
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "if") (docLit $ Text.pack "if")
(layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsLet _ binds exp1 -> do HsLet _ binds exp1 -> do
#else
HsLet binds exp1 -> do
#endif
expDoc1 <- docSharedWrapper layoutExpr exp1 expDoc1 <- docSharedWrapper layoutExpr exp1
-- We jump through some ugly hoops here to ensure proper sharing. -- We jump through some ugly hoops here to ensure proper sharing.
hasComments <- hasAnyCommentsBelow lexpr hasComments <- hasAnyCommentsBelow lexpr
@ -860,11 +722,7 @@ layoutExpr lexpr@(L _ expr) = do
] ]
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of
#else
HsDo stmtCtx (L _ stmts) _ -> case stmtCtx of
#endif
DoExpr -> do DoExpr -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
docSetParSpacing docSetParSpacing
@ -959,53 +817,40 @@ layoutExpr lexpr@(L _ expr) = do
in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
ExplicitList _ _ [] -> ExplicitList _ _ [] ->
docLit $ Text.pack "[]" docLit $ Text.pack "[]"
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
ExplicitPArr{} -> do
-- TODO
briDocByExactInlineOnly "ExplicitPArr{}" lexpr
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecordCon _ lname fields -> RecordCon _ lname fields ->
#else
RecordCon lname _ _ fields ->
#endif
case fields of case fields of
HsRecFields fs Nothing -> do HsRecFields fs Nothing -> do
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
rFs <- fs rFs <- fs
`forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
#else
let FieldOcc lnameF _ = fieldOcc
#endif
rFExpDoc <- if pun rFExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr rFExpr else Just <$> docSharedWrapper layoutExpr rFExpr
return $ (lfield, lrdrNameToText lnameF, rFExpDoc) return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
recordExpression False indentPolicy lexpr nameDoc rFs recordExpression False indentPolicy lexpr nameDoc rFs
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields [] (Just (L _ 0)) -> do
#else
HsRecFields [] (Just 0) -> do HsRecFields [] (Just 0) -> do
#endif
let t = lrdrNameToText lname let t = lrdrNameToText lname
docWrapNode lname $ docLit $ t <> Text.pack " { .. }" docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields fs@(_:_) (Just (L _ dotdoti)) | dotdoti == length fs -> do
#else
HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
#endif
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
#else
let FieldOcc lnameF _ = fieldOcc
#endif
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr else Just <$> docSharedWrapper layoutExpr fExpr
return (fieldl, lrdrNameToText lnameF, fExpDoc) return (fieldl, lrdrNameToText lnameF, fExpDoc)
recordExpression True indentPolicy lexpr nameDoc fieldDocs recordExpression True indentPolicy lexpr nameDoc fieldDocs
_ -> unknownNodeError "RecordCon with puns" lexpr _ -> unknownNodeError "RecordCon with puns" lexpr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecordUpd _ rExpr fields -> do RecordUpd _ rExpr fields -> do
#else
RecordUpd rExpr fields _ _ _ _ -> do
#endif
rExprDoc <- docSharedWrapper layoutExpr rExpr rExprDoc <- docSharedWrapper layoutExpr rExpr
rFs <- fields rFs <- fields
`forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
@ -1013,15 +858,10 @@ layoutExpr lexpr@(L _ expr) = do
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutExpr rFExpr else Just <$> docSharedWrapper layoutExpr rFExpr
return $ case ambName of return $ case ambName of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
XAmbiguousFieldOcc{} -> XAmbiguousFieldOcc{} ->
error "brittany internal error: XAmbiguousFieldOcc" error "brittany internal error: XAmbiguousFieldOcc"
#else
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
#endif
recordExpression False indentPolicy lexpr rExprDoc rFs recordExpression False indentPolicy lexpr rExprDoc rFs
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */ #if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */
ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) -> ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) ->
@ -1029,16 +869,12 @@ layoutExpr lexpr@(L _ expr) = do
ExprWithTySig _ _ XHsWildCardBndrs{} -> ExprWithTySig _ _ XHsWildCardBndrs{} ->
error "brittany internal error: ExprWithTySig XHsWildCardBndrs" error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #else
ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ -> ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->
error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs" error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
ExprWithTySig XHsWildCardBndrs{} _ -> ExprWithTySig XHsWildCardBndrs{} _ ->
error "brittany internal error: ExprWithTySig XHsWildCardBndrs" error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8,4 */
ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
#else /* ghc-8.0 */
ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do
#endif #endif
expDoc <- docSharedWrapper layoutExpr exp1 expDoc <- docSharedWrapper layoutExpr exp1
typDoc <- docSharedWrapper layoutType typ1 typDoc <- docSharedWrapper layoutType typ1
@ -1047,11 +883,6 @@ layoutExpr lexpr@(L _ expr) = do
, appSep $ docLit $ Text.pack "::" , appSep $ docLit $ Text.pack "::"
, typDoc , typDoc
] ]
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
ExprWithTySigOut{} -> do
-- TODO
briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr
#endif
ArithSeq _ Nothing info -> ArithSeq _ Nothing info ->
case info of case info of
From e1 -> do From e1 -> do
@ -1096,11 +927,6 @@ layoutExpr lexpr@(L _ expr) = do
] ]
ArithSeq{} -> ArithSeq{} ->
briDocByExactInlineOnly "ArithSeq" lexpr briDocByExactInlineOnly "ArithSeq" lexpr
#if !MIN_VERSION_ghc(8,6,0) /* ghc-8.0 8.2 8.4 */
PArrSeq{} -> do
-- TODO
briDocByExactInlineOnly "PArrSeq{}" lexpr
#endif
HsSCC{} -> do HsSCC{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsSCC{}" lexpr briDocByExactInlineOnly "HsSCC{}" lexpr
@ -1116,11 +942,7 @@ layoutExpr lexpr@(L _ expr) = do
HsTcBracketOut{} -> do HsTcBracketOut{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsTcBracketOut{}" lexpr briDocByExactInlineOnly "HsTcBracketOut{}" lexpr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do HsSpliceE _ (HsQuasiQuote _ _ quoter _loc content) -> do
#else
HsSpliceE (HsQuasiQuote _ quoter _loc content) -> do
#endif
allocateNode $ BDFPlain allocateNode $ BDFPlain
(Text.pack (Text.pack
$ "[" $ "["
@ -1137,12 +959,15 @@ layoutExpr lexpr@(L _ expr) = do
HsStatic{} -> do HsStatic{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsStatic{}" lexpr briDocByExactInlineOnly "HsStatic{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
HsArrApp{} -> do HsArrApp{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsArrApp{}" lexpr briDocByExactInlineOnly "HsArrApp{}" lexpr
HsArrForm{} -> do HsArrForm{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsArrForm{}" lexpr briDocByExactInlineOnly "HsArrForm{}" lexpr
#endif
HsTick{} -> do HsTick{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsTick{}" lexpr briDocByExactInlineOnly "HsTick{}" lexpr
@ -1152,13 +977,11 @@ layoutExpr lexpr@(L _ expr) = do
HsTickPragma{} -> do HsTickPragma{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsTickPragma{}" lexpr briDocByExactInlineOnly "HsTickPragma{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
EWildPat{} -> do EWildPat{} -> do
docLit $ Text.pack "_" docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
EAsPat _ asName asExpr -> do EAsPat _ asName asExpr -> do
#else
EAsPat asName asExpr -> do
#endif
docSeq docSeq
[ docLit $ lrdrNameToText asName <> Text.pack "@" [ docLit $ lrdrNameToText asName <> Text.pack "@"
, layoutExpr asExpr , layoutExpr asExpr
@ -1169,20 +992,17 @@ layoutExpr lexpr@(L _ expr) = do
ELazyPat{} -> do ELazyPat{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "ELazyPat{}" lexpr briDocByExactInlineOnly "ELazyPat{}" lexpr
#endif
HsWrap{} -> do HsWrap{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr briDocByExactInlineOnly "HsWrap{}" lexpr
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsConLikeOut{} -> do HsConLikeOut{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr briDocByExactInlineOnly "HsWrap{}" lexpr
ExplicitSum{} -> do ExplicitSum{} -> do
-- TODO -- TODO
briDocByExactInlineOnly "ExplicitSum{}" lexpr briDocByExactInlineOnly "ExplicitSum{}" lexpr
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
XExpr{} -> error "brittany internal error: XExpr" XExpr{} -> error "brittany internal error: XExpr"
#endif
recordExpression recordExpression
:: (Data.Data.Data lExpr, Data.Data.Data name) :: (Data.Data.Data lExpr, Data.Data.Data name)
@ -1320,7 +1140,6 @@ recordExpression dotdot indentPolicy lexpr nameDoc rFs@(rF1:rFr) = do
in [line1] ++ lineR ++ [dotdotLine, lineN] in [line1] ++ lineR ++ [dotdotLine, lineN]
) )
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
litBriDoc :: HsLit GhcPs -> BriDocFInt litBriDoc :: HsLit GhcPs -> BriDocFInt
litBriDoc = \case litBriDoc = \case
HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\''] HsChar (SourceText t) _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
@ -1344,50 +1163,3 @@ overLitValBriDoc = \case
HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t HsFractional (FL (SourceText t) _ _) -> BDFLit $ Text.pack t
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
_ -> error "overLitValBriDoc: literal with no SourceText" _ -> 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, '\'']
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 (SourceText t) _i -> 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 t _) _type -> BDFLit $ Text.pack t
HsFloatPrim (FL t _) -> BDFLit $ Text.pack t
HsDoublePrim (FL t _) -> BDFLit $ Text.pack t
_ -> error "litBriDoc: literal with no SourceText"
overLitValBriDoc :: OverLitVal -> BriDocFInt
overLitValBriDoc = \case
HsIntegral (SourceText t) _ -> BDFLit $ Text.pack t
HsFractional (FL t _) -> BDFLit $ Text.pack t
HsIsString (SourceText t) _ -> BDFLit $ Text.pack t
_ -> error "overLitValBriDoc: literal with no SourceText"
#else /* ghc-8.0 */
litBriDoc :: HsLit -> BriDocFInt
litBriDoc = \case
HsChar t _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
HsCharPrim t _c -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ ['\'', c, '\'']
HsString t _fastString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ FastString.unpackFS fastString
HsStringPrim t _byteString -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ Data.ByteString.Char8.unpack byteString
HsInt t _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsIntPrim t _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsWordPrim t _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsInt64Prim t _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsWord64Prim t _i -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsInteger t _i _type -> BDFLit $ Text.pack t -- BDFLit $ Text.pack $ show i
HsRat (FL t _) _type -> BDFLit $ Text.pack t
HsFloatPrim (FL t _) -> BDFLit $ Text.pack t
HsDoublePrim (FL t _) -> BDFLit $ Text.pack t
overLitValBriDoc :: OverLitVal -> BriDocFInt
overLitValBriDoc = \case
HsIntegral t _ -> BDFLit $ Text.pack t
HsFractional (FL t _) -> BDFLit $ Text.pack t
HsIsString t _ -> BDFLit $ Text.pack t
#endif

View File

@ -15,7 +15,11 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString ) import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
@ -24,10 +28,6 @@ layoutExpr :: ToBriDoc HsExpr
-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs)) -- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
litBriDoc :: HsLit GhcPs -> BriDocFInt litBriDoc :: HsLit GhcPs -> BriDocFInt
#else /* ghc-8.0 && ghc-8.2 */
litBriDoc :: HsLit -> BriDocFInt
#endif
overLitValBriDoc :: OverLitVal -> BriDocFInt overLitValBriDoc :: OverLitVal -> BriDocFInt

View File

@ -18,9 +18,14 @@ import GHC ( unLoc
, AnnKeywordId(..) , AnnKeywordId(..)
, Located , Located
) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn import HsSyn
import Name
import HsImpExp import HsImpExp
#endif
import Name
import FieldLabel import FieldLabel
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes
@ -29,42 +34,17 @@ import Language.Haskell.Brittany.Internal.Utils
#if MIN_VERSION_ghc(8,2,0)
prepareName :: LIEWrappedName name -> Located name prepareName :: LIEWrappedName name -> Located name
prepareName = ieLWrappedName prepareName = ieLWrappedName
#else
prepareName :: Located name -> Located name
prepareName = id
#endif
layoutIE :: ToBriDoc IE layoutIE :: ToBriDoc IE
layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
#if MIN_VERSION_ghc(8,6,0)
IEVar _ x -> layoutWrapped lie x IEVar _ x -> layoutWrapped lie x
#else
IEVar x -> layoutWrapped lie x
#endif
#if MIN_VERSION_ghc(8,6,0)
IEThingAbs _ x -> layoutWrapped lie x IEThingAbs _ x -> layoutWrapped lie x
#else
IEThingAbs x -> layoutWrapped lie x
#endif
#if MIN_VERSION_ghc(8,6,0)
IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
#else
IEThingAll x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
#endif
#if MIN_VERSION_ghc(8,6,0)
IEThingWith _ x (IEWildcard _) _ _ -> IEThingWith _ x (IEWildcard _) _ _ ->
#else
IEThingWith x (IEWildcard _) _ _ ->
#endif
docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"] docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
#if MIN_VERSION_ghc(8,6,0)
IEThingWith _ x _ ns _ -> do IEThingWith _ x _ ns _ -> do
#else
IEThingWith x _ ns _ -> do
#endif
hasComments <- orM hasComments <- orM
( hasCommentsBetween lie AnnOpenP AnnCloseP ( hasCommentsBetween lie AnnOpenP AnnCloseP
: hasAnyCommentsBelow x : hasAnyCommentsBelow x
@ -95,18 +75,13 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
$ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]] $ [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
++ map layoutItem nMs ++ map layoutItem nMs
++ [docSeq [docCommaSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc nN], docParenR] ++ [docSeq [docCommaSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc nN], docParenR]
#if MIN_VERSION_ghc(8,6,0)
IEModuleContents _ n -> docSeq IEModuleContents _ n -> docSeq
#else
IEModuleContents n -> docSeq
#endif
[ docLit $ Text.pack "module" [ docLit $ Text.pack "module"
, docSeparator , docSeparator
, docLit . Text.pack . moduleNameString $ unLoc n , docLit . Text.pack . moduleNameString $ unLoc n
] ]
_ -> docEmpty _ -> docEmpty
where where
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2, 8.4, .. */
layoutWrapped _ = \case layoutWrapped _ = \case
L _ (IEName n) -> docLit =<< lrdrNameToTextAnn n L _ (IEName n) -> docLit =<< lrdrNameToTextAnn n
L _ (IEPattern n) -> do L _ (IEPattern n) -> do
@ -115,16 +90,6 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
L _ (IEType n) -> do L _ (IEType n) -> do
name <- lrdrNameToTextAnn n name <- lrdrNameToTextAnn n
docLit $ Text.pack "type " <> name docLit $ Text.pack "type " <> name
#else /* ghc-8.0 */
layoutWrapped outer n = do
name <- lrdrNameToTextAnn n
hasType <- hasAnnKeyword n AnnType
hasPattern <- hasAnnKeyword outer AnnPattern
docLit $ if
| hasType -> Text.pack "type (" <> name <> Text.pack ")"
| hasPattern -> Text.pack "pattern " <> name
| otherwise -> name
#endif
-- Helper function to deal with Located lists of LIEs. -- Helper function to deal with Located lists of LIEs.
-- In particular this will also associate documentation -- In particular this will also associate documentation

View File

@ -12,7 +12,11 @@ import GHC ( unLoc
, moduleNameString , moduleNameString
, Located , Located
) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import FieldLabel import FieldLabel
import qualified FastString import qualified FastString
@ -22,32 +26,18 @@ import Language.Haskell.Brittany.Internal.Utils
#if MIN_VERSION_ghc(8,2,0)
prepPkg :: SourceText -> String prepPkg :: SourceText -> String
prepPkg rawN = case rawN of prepPkg rawN = case rawN of
SourceText n -> n SourceText n -> n
-- This would be odd to encounter and the -- This would be odd to encounter and the
-- result will most certainly be wrong -- result will most certainly be wrong
NoSourceText -> "" NoSourceText -> ""
#else
prepPkg :: String -> String
prepPkg = id
#endif
#if MIN_VERSION_ghc(8,2,0)
prepModName :: Located e -> e prepModName :: Located e -> e
prepModName = unLoc prepModName = unLoc
#else
prepModName :: e -> e
prepModName = id
#endif
layoutImport :: ToBriDoc ImportDecl layoutImport :: ToBriDoc ImportDecl
layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
#if MIN_VERSION_ghc(8,6,0)
ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do
#else
ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do
#endif
importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
@ -59,7 +49,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
hiding = maybe False fst mllies hiding = maybe False fst mllies
minQLength = length "import qualified " minQLength = length "import qualified "
qLengthReal = qLengthReal =
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let qualifiedPart = if q /= NotQualified then length "qualified " else 0
#else
let qualifiedPart = if q then length "qualified " else 0 let qualifiedPart = if q then length "qualified " else 0
#endif
safePart = if safe then length "safe " else 0 safePart = if safe then length "safe " else 0
pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT
srcPart = if src then length "{-# SOURCE #-} " else 0 srcPart = if src then length "{-# SOURCE #-} " else 0
@ -73,7 +67,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
[ appSep $ docLit $ Text.pack "import" [ appSep $ docLit $ Text.pack "import"
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
, if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty
#else
, if q then appSep $ docLit $ Text.pack "qualified" else docEmpty , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
#endif
, maybe docEmpty (appSep . docLit) pkgNameT , maybe docEmpty (appSep . docLit) pkgNameT
] ]
indentName = indentName =

View File

@ -9,9 +9,14 @@ import Language.Haskell.Brittany.Internal.Layouters.Import
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn import HsSyn
import Name
import HsImpExp import HsImpExp
#endif
import Name
import FieldLabel import FieldLabel
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes

View File

@ -21,7 +21,11 @@ import GHC ( Located
, ol_val , ol_val
) )
import qualified GHC import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import BasicTypes import BasicTypes
@ -44,26 +48,16 @@ layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered)
layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr -- _ -> expr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
VarPat _ n -> VarPat _ n ->
#else /* ghc-8.0 8.2 8.4 */
VarPat n ->
#endif
fmap Seq.singleton $ docLit $ lrdrNameToText n fmap Seq.singleton $ docLit $ lrdrNameToText n
-- abc -> expr -- abc -> expr
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LitPat _ lit -> LitPat _ lit ->
#else /* ghc-8.0 8.2 8.4 */
LitPat lit ->
#endif
fmap Seq.singleton $ allocateNode $ litBriDoc lit fmap Seq.singleton $ allocateNode $ litBriDoc lit
-- 0 -> expr -- 0 -> expr
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ #if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
ParPat _ inner -> do ParPat _ inner -> do
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #else
ParPat _ inner -> do ParPat _ inner -> do
#else /* ghc-8.0 8.2 8.4 */
ParPat inner -> do
#endif #endif
-- (nestedpat) -> expr -- (nestedpat) -> expr
left <- docLit $ Text.pack "(" left <- docLit $ Text.pack "("
@ -113,11 +107,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
-- Abc { a, b, c } -> expr2 -- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
#else
let FieldOcc lnameF _ = fieldOcc
#endif
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat else Just <$> docSharedWrapper layoutPat fPat
@ -136,22 +126,26 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
, docSeparator , docSeparator
, docLit $ Text.pack "}" , docLit $ Text.pack "}"
] ]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
#else
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
#endif
-- Abc { .. } -> expr -- Abc { .. } -> expr
let t = lrdrNameToText lname let t = lrdrNameToText lname
Seq.singleton <$> docSeq Seq.singleton <$> docSeq
[ appSep $ docLit t [ appSep $ docLit t
, docLit $ Text.pack "{..}" , docLit $ Text.pack "{..}"
] ]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
#else
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
#endif
-- Abc { a = locA, .. } -- Abc { a = locA, .. }
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let FieldOcc _ lnameF = fieldOcc let FieldOcc _ lnameF = fieldOcc
#else
let FieldOcc lnameF _ = fieldOcc
#endif
fExpDoc <- if pun fExpDoc <- if pun
then return Nothing then return Nothing
else Just <$> docSharedWrapper layoutPat fPat else Just <$> docSharedWrapper layoutPat fPat
@ -169,31 +163,19 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
(fieldName, Nothing) -> [docLit fieldName, docCommaSep] (fieldName, Nothing) -> [docLit fieldName, docCommaSep]
, docLit $ Text.pack "..}" , docLit $ Text.pack "..}"
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
TuplePat _ args boxity -> do TuplePat _ args boxity -> do
#else
TuplePat args boxity _ -> do
#endif
-- (nestedpat1, nestedpat2, nestedpat3) -> expr -- (nestedpat1, nestedpat2, nestedpat3) -> expr
-- (#nestedpat1, nestedpat2, nestedpat3#) -> expr -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr
case boxity of case boxity of
Boxed -> wrapPatListy args "()" docParenL docParenR Boxed -> wrapPatListy args "()" docParenL docParenR
Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
AsPat _ asName asPat -> do AsPat _ asName asPat -> do
#else
AsPat asName asPat -> do
#endif
-- bind@nestedpat -> expr -- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ #if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #else
SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do
#else /* ghc-8.0 */
SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do
#endif #endif
-- i :: Int -> expr -- i :: Int -> expr
patDocs <- layoutPat pat1 patDocs <- layoutPat pat1
@ -214,33 +196,17 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
, docForceSingleline tyDoc , docForceSingleline tyDoc
] ]
return $ xR Seq.|> xN' return $ xR Seq.|> xN'
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
ListPat _ elems -> ListPat _ elems ->
#else
ListPat elems _ _ ->
#endif
-- [] -> expr1 -- [] -> expr1
-- [nestedpat1, nestedpat2, nestedpat3] -> expr2 -- [nestedpat1, nestedpat2, nestedpat3] -> expr2
wrapPatListy elems "[]" docBracketL docBracketR wrapPatListy elems "[]" docBracketL docBracketR
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BangPat _ pat1 -> do BangPat _ pat1 -> do
#else
BangPat pat1 -> do
#endif
-- !nestedpat -> expr -- !nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "!") wrapPatPrepend pat1 (docLit $ Text.pack "!")
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LazyPat _ pat1 -> do LazyPat _ pat1 -> do
#else
LazyPat pat1 -> do
#endif
-- ~nestedpat -> expr -- ~nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "~") wrapPatPrepend pat1 (docLit $ Text.pack "~")
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
NPat _ llit@(L _ ol) mNegative _ -> do NPat _ llit@(L _ ol) mNegative _ -> do
#else
NPat llit@(L _ ol) mNegative _ _ -> do
#endif
-- -13 -> expr -- -13 -> expr
litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
negDoc <- docLit $ Text.pack "-" negDoc <- docLit $ Text.pack "-"
@ -248,11 +214,6 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
Just{} -> Seq.fromList [negDoc, litDoc] Just{} -> Seq.fromList [negDoc, litDoc]
Nothing -> Seq.singleton litDoc Nothing -> Seq.singleton litDoc
-- if MIN_VERSION_ghc(8,0,0)
-- VarPat n -> return $ stringLayouter lpat $ lrdrNameToText n
-- else
-- VarPat n -> return $ stringLayouter lpat $ rdrNameToText n
-- endif
_ -> return <$> briDocByExactInlineOnly "some unknown pattern" (ghcDL lpat) _ -> return <$> briDocByExactInlineOnly "some unknown pattern" (ghcDL lpat)
colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered

View File

@ -17,7 +17,11 @@ import GHC ( runGhc
, GenLocated(L) , GenLocated(L)
, moduleNameString , moduleNameString
) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes
@ -34,17 +38,9 @@ layoutStmt lstmt@(L _ stmt) = do
indentAmount :: Int <- indentAmount :: Int <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
docWrapNode lstmt $ case stmt of docWrapNode lstmt $ case stmt of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LastStmt _ body False _ -> do LastStmt _ body False _ -> do
#else
LastStmt body False _ -> do
#endif
layoutExpr body layoutExpr body
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BindStmt _ lPat expr _ _ -> do BindStmt _ lPat expr _ _ -> do
#else
BindStmt lPat expr _ _ _ -> do
#endif
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAlt docAlt
@ -63,11 +59,7 @@ layoutStmt lstmt@(L _ stmt) = do
$ docPar (docLit $ Text.pack "<-") (expDoc) $ docPar (docLit $ Text.pack "<-") (expDoc)
] ]
] ]
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
LetStmt _ binds -> do LetStmt _ binds -> do
#else
LetStmt binds -> do
#endif
let isFree = indentPolicy == IndentPolicyFree let isFree = indentPolicy == IndentPolicyFree
let indentFourPlus = indentAmount >= 4 let indentFourPlus = indentAmount >= 4
layoutLocalBinds binds >>= \case layoutLocalBinds binds >>= \case
@ -112,11 +104,7 @@ layoutStmt lstmt@(L _ stmt) = do
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "let") $ docPar (docLit $ Text.pack "let")
(docSetBaseAndIndent $ docLines $ return <$> bindDocs) (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do
#else
RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
#endif
-- rec stmt1 -- rec stmt1
-- stmt2 -- stmt2
-- stmt3 -- stmt3
@ -132,11 +120,7 @@ layoutStmt lstmt@(L _ stmt) = do
addAlternative $ docAddBaseY BrIndentRegular $ docPar addAlternative $ docAddBaseY BrIndentRegular $ docPar
(docLit (Text.pack "rec")) (docLit (Text.pack "rec"))
(docLines $ layoutStmt <$> stmts) (docLines $ layoutStmt <$> stmts)
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
BodyStmt _ expr _ _ -> do BodyStmt _ expr _ _ -> do
#else
BodyStmt expr _ _ _ -> do
#endif
expDoc <- docSharedWrapper layoutExpr expr expDoc <- docSharedWrapper layoutExpr expr
docAddBaseY BrIndentRegular $ expDoc docAddBaseY BrIndentRegular $ expDoc
_ -> briDocByExactInlineOnly "some unknown statement" lstmt _ -> briDocByExactInlineOnly "some unknown statement" lstmt

View File

@ -13,7 +13,11 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString ) import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes

View File

@ -25,7 +25,11 @@ import GHC ( runGhc
, AnnKeywordId (..) , AnnKeywordId (..)
) )
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn import HsSyn
#endif
import Name import Name
import Outputable ( ftext, showSDocUnsafe ) import Outputable ( ftext, showSDocUnsafe )
import BasicTypes import BasicTypes
@ -38,17 +42,12 @@ import DataTreePrint
layoutType :: ToBriDoc HsType layoutType :: ToBriDoc HsType
layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
-- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible"
#if MIN_VERSION_ghc(8,2,0)
#if MIN_VERSION_ghc(8,6,0)
HsTyVar _ promoted name -> do HsTyVar _ promoted name -> do
#else /* ghc-8.2 ghc-8.4 */
HsTyVar promoted name -> do
#endif
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
case promoted of case promoted of
#if MIN_VERSION_ghc(8,8,0) #if MIN_VERSION_ghc(8,8,0)
IsPromoted -> docSeq IsPromoted -> docSeq
#else /* ghc-8.2 8.4 8.6 */ #else /* ghc-8.6 */
Promoted -> docSeq Promoted -> docSeq
#endif #endif
[ docSeparator [ docSeparator
@ -56,15 +55,10 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docWrapNode name $ docLit t , docWrapNode name $ docLit t
] ]
NotPromoted -> docWrapNode name $ docLit t NotPromoted -> docWrapNode name $ docLit t
#else /* ghc-8.0 */ #if MIN_VERSION_ghc(8,10,1)
HsTyVar name -> do HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
docWrapNode name $ docLit t
#endif
#if MIN_VERSION_ghc(8,6,0)
HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#else #else
HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#endif #endif
typeDoc <- docSharedWrapper layoutType typ2 typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs tyVarDocs <- layoutTyVarBndrs bndrs
@ -151,10 +145,10 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
) )
] ]
#if MIN_VERSION_ghc(8,6,0) #if MIN_VERSION_ghc(8,10,1)
HsForAllTy _ bndrs typ2 -> do HsForAllTy _ _ bndrs typ2 -> do
#else #else
HsForAllTy bndrs typ2 -> do HsForAllTy _ bndrs typ2 -> do
#endif #endif
typeDoc <- layoutType typ2 typeDoc <- layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs tyVarDocs <- layoutTyVarBndrs bndrs
@ -210,11 +204,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
) )
] ]
#if MIN_VERSION_ghc(8,6,0)
HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do
#else
HsQualTy lcntxts@(L _ cntxts) typ1 -> do
#endif
typeDoc <- docSharedWrapper layoutType typ1 typeDoc <- docSharedWrapper layoutType typ1
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
let let
@ -264,11 +254,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
) )
] ]
#if MIN_VERSION_ghc(8,6,0)
HsFunTy _ typ1 typ2 -> do HsFunTy _ typ1 typ2 -> do
#else
HsFunTy typ1 typ2 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2 typeDoc2 <- docSharedWrapper layoutType typ2
let maybeForceML = case typ2 of let maybeForceML = case typ2 of
@ -292,11 +278,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
) )
] ]
#if MIN_VERSION_ghc(8,6,0)
HsParTy _ typ1 -> do HsParTy _ typ1 -> do
#else
HsParTy typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
[ docSeq [ docSeq
@ -311,7 +293,6 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]) ])
(docLit $ Text.pack ")") (docLit $ Text.pack ")")
] ]
#if MIN_VERSION_ghc(8,6,0)
HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do
let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs]) let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])
gather list = \case gather list = \case
@ -339,65 +320,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
typeDoc1 typeDoc1
(docEnsureIndent BrIndentRegular typeDoc2) (docEnsureIndent BrIndentRegular typeDoc2)
] ]
#else
HsAppTy typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2
docAlt
[ docSeq
[ docForceSingleline typeDoc1
, docSeparator
, docForceSingleline typeDoc2
]
, docPar
typeDoc1
(docEnsureIndent BrIndentRegular typeDoc2)
]
HsAppsTy [] -> error "HsAppsTy []"
HsAppsTy [L _ (HsAppPrefix typ1)] -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc1
HsAppsTy [lname@(L _ (HsAppInfix name))] -> do
-- this redirection is somewhat hacky, but whatever.
-- TODO: a general problem when doing deep inspections on
-- the type (and this is not the only instance)
-- is that we potentially omit annotations on some of
-- the middle constructors. i have no idea under which
-- circumstances exactly important annotations (comments)
-- would be assigned to such constructors.
typeDoc1 <- -- docSharedWrapper layoutType $ (L l $ HsTyVar name)
lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lname name
docLit typeDoc1
HsAppsTy (L _ (HsAppPrefix typHead):typRestA)
| Just typRest <- mapM (\case L _ (HsAppPrefix t) -> Just t
_ -> Nothing) typRestA -> do
docHead <- docSharedWrapper layoutType typHead
docRest <- docSharedWrapper layoutType `mapM` typRest
docAlt
[ docSeq
$ docForceSingleline docHead : (docRest >>= \d ->
[ docSeparator, docForceSingleline d ])
, docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
]
HsAppsTy (typHead:typRest) -> do
docHead <- docSharedWrapper layoutAppType typHead
docRest <- docSharedWrapper layoutAppType `mapM` typRest
docAlt
[ docSeq
$ docForceSingleline docHead : (docRest >>= \d ->
[ docSeparator, docForceSingleline d ])
, docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
]
where
layoutAppType (L _ (HsAppPrefix t)) = layoutType t
layoutAppType lt@(L _ (HsAppInfix t)) =
docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t
#endif
#if MIN_VERSION_ghc(8,6,0)
HsListTy _ typ1 -> do HsListTy _ typ1 -> do
#else
HsListTy typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
[ docSeq [ docSeq
@ -412,29 +335,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]) ])
(docLit $ Text.pack "]") (docLit $ Text.pack "]")
] ]
#if MIN_VERSION_ghc(8,6,0)
#else
HsPArrTy typ1 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
docAlt
[ docSeq
[ docWrapNodeRest ltype $ docLit $ Text.pack "[:"
, docForceSingleline typeDoc1
, docLit $ Text.pack ":]"
]
, docPar
( docCols ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack "[:"
, docAddBaseY (BrIndentSpecial 2) $ typeDoc1
])
(docLit $ Text.pack ":]")
]
#endif
#if MIN_VERSION_ghc(8,6,0)
HsTupleTy _ tupleSort typs -> case tupleSort of HsTupleTy _ tupleSort typs -> case tupleSort of
#else
HsTupleTy tupleSort typs -> case tupleSort of
#endif
HsUnboxedTuple -> unboxed HsUnboxedTuple -> unboxed
HsBoxedTuple -> simple HsBoxedTuple -> simple
HsConstraintTuple -> simple HsConstraintTuple -> simple
@ -537,13 +438,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
-- } -- }
-- , _layouter_ast = ltype -- , _layouter_ast = ltype
-- } -- }
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do
#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
HsIParamTy (L _ (HsIPName ipName)) typ1 -> do
#else /* ghc-8.0 */
HsIParamTy (HsIPName ipName) typ1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
docAlt docAlt
[ docSeq [ docSeq
@ -562,33 +457,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
, docAddBaseY (BrIndentSpecial 2) typeDoc1 , docAddBaseY (BrIndentSpecial 2) typeDoc1
]) ])
] ]
#if MIN_VERSION_ghc(8,6,0)
#else
HsEqTy typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2
docAlt
[ docSeq
[ docForceSingleline typeDoc1
, docWrapNodeRest ltype
$ docLit $ Text.pack " ~ "
, docForceSingleline typeDoc2
]
, docPar
typeDoc1
( docCols ColTyOpPrefix
[ docWrapNodeRest ltype
$ docLit $ Text.pack "~ "
, docAddBaseY (BrIndentSpecial 2) typeDoc2
])
]
#endif
-- TODO: test KindSig -- TODO: test KindSig
#if MIN_VERSION_ghc(8,6,0)
HsKindSig _ typ1 kind1 -> do HsKindSig _ typ1 kind1 -> do
#else
HsKindSig typ1 kind1 -> do
#endif
typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 <- docSharedWrapper layoutType typ1
kindDoc1 <- docSharedWrapper layoutType kind1 kindDoc1 <- docSharedWrapper layoutType kind1
hasParens <- hasAnnKeyword ltype AnnOpenP hasParens <- hasAnnKeyword ltype AnnOpenP
@ -691,11 +561,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
briDocByExactInlineOnly "HsDocTy{}" ltype briDocByExactInlineOnly "HsDocTy{}" ltype
HsRecTy{} -> -- TODO HsRecTy{} -> -- TODO
briDocByExactInlineOnly "HsRecTy{}" ltype briDocByExactInlineOnly "HsRecTy{}" ltype
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsExplicitListTy _ _ typs -> do HsExplicitListTy _ _ typs -> do
#else /* ghc-8.0 */
HsExplicitListTy _ typs -> do
#endif
typDocs <- docSharedWrapper layoutType `mapM` typs typDocs <- docSharedWrapper layoutType `mapM` typs
hasComments <- hasAnyCommentsBelow ltype hasComments <- hasAnyCommentsBelow ltype
let specialCommaSep = appSep $ docLit $ Text.pack " ," let specialCommaSep = appSep $ docLit $ Text.pack " ,"
@ -742,39 +608,22 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
HsExplicitTupleTy{} -> -- TODO HsExplicitTupleTy{} -> -- TODO
briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype
#if MIN_VERSION_ghc(8,6,0)
HsTyLit _ lit -> case lit of HsTyLit _ lit -> case lit of
#else
HsTyLit lit -> case lit of
#endif
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
HsNumTy NoSourceText _ -> HsNumTy NoSourceText _ ->
error "overLitValBriDoc: literal with no SourceText" error "overLitValBriDoc: literal with no SourceText"
HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext
HsStrTy NoSourceText _ -> HsStrTy NoSourceText _ ->
error "overLitValBriDoc: literal with no SourceText" error "overLitValBriDoc: literal with no SourceText"
#else /* ghc-8.0 */
HsNumTy srctext _ -> docLit $ Text.pack srctext
HsStrTy srctext _ -> docLit $ Text.pack srctext
#endif
#if !MIN_VERSION_ghc(8,6,0)
HsCoreTy{} -> -- TODO
briDocByExactInlineOnly "HsCoreTy{}" ltype
#endif
HsWildCardTy _ -> HsWildCardTy _ ->
docLit $ Text.pack "_" docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
HsSumTy{} -> -- TODO HsSumTy{} -> -- TODO
briDocByExactInlineOnly "HsSumTy{}" ltype briDocByExactInlineOnly "HsSumTy{}" ltype
#endif
#if MIN_VERSION_ghc(8,6,0)
HsStarTy _ isUnicode -> do HsStarTy _ isUnicode -> do
if isUnicode if isUnicode
then docLit $ Text.pack "\x2605" -- Unicode star then docLit $ Text.pack "\x2605" -- Unicode star
else docLit $ Text.pack "*" else docLit $ Text.pack "*"
XHsType{} -> error "brittany internal error: XHsType" XHsType{} -> error "brittany internal error: XHsType"
#endif
#if MIN_VERSION_ghc(8,8,0) #if MIN_VERSION_ghc(8,8,0)
HsAppKindTy _ ty kind -> do HsAppKindTy _ ty kind -> do
t <- docSharedWrapper layoutType ty t <- docSharedWrapper layoutType ty
@ -796,18 +645,11 @@ layoutTyVarBndrs
:: [LHsTyVarBndr GhcPs] :: [LHsTyVarBndr GhcPs]
-> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))] -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))]
layoutTyVarBndrs = mapM $ \case layoutTyVarBndrs = mapM $ \case
#if MIN_VERSION_ghc(8,6,0)
(L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar _ lrdrName kind)) -> do (L _ (KindedTyVar _ lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d) return $ (lrdrNameToText lrdrName, Just $ d)
(L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"
#else
(L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d)
#endif
-- there is no specific reason this returns a list instead of a single -- there is no specific reason this returns a list instead of a single
-- BriDoc node. -- BriDoc node.

View File

@ -1,8 +1,3 @@
#if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */
{-# LANGUAGE TypeFamilies #-}
#endif
module Language.Haskell.Brittany.Internal.Prelude module Language.Haskell.Brittany.Internal.Prelude
( module E ( module E
, module Language.Haskell.Brittany.Internal.Prelude , module Language.Haskell.Brittany.Internal.Prelude
@ -13,9 +8,11 @@ where
-- rather project-specific stuff: -- rather project-specific stuff:
--------------------------------- ---------------------------------
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs.Extension as E ( GhcPs )
#else
import HsExtension as E ( GhcPs ) import HsExtension as E ( GhcPs )
#endif #endif /* ghc-8.10.1 */
import RdrName as E ( RdrName ) import RdrName as E ( RdrName )
#if MIN_VERSION_ghc(8,8,0) #if MIN_VERSION_ghc(8,8,0)
@ -407,18 +404,10 @@ todo :: a
todo = error "todo" todo = error "todo"
#if !MIN_VERSION_ghc(8,4,0) /* ghc-8.0, ghc-8.2 */
type family IdP p
type instance IdP GhcPs = RdrName
type GhcPs = RdrName
#endif
#if MIN_VERSION_ghc(8,8,0) #if MIN_VERSION_ghc(8,8,0)
ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a) ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a)
ghcDL = GHC.dL ghcDL = GHC.dL
#else /* ghc-8.0 8.2 8.4 8.6 */ #else /* ghc-8.6 */
ghcDL :: GHC.Located a -> GHC.Located a ghcDL :: GHC.Located a -> GHC.Located a
ghcDL x = x ghcDL x = x
#endif #endif

View File

@ -32,9 +32,7 @@ data PerItemConfig = PerItemConfig
{ _icd_perBinding :: Map String (CConfig Option) { _icd_perBinding :: Map String (CConfig Option)
, _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option) , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option)
} }
#if MIN_VERSION_ghc(8,2,0)
deriving Data.Data.Data deriving Data.Data.Data
#endif
type PPM = MultiRWSS.MultiRWS type PPM = MultiRWSS.MultiRWS
'[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns] '[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns]

View File

@ -59,9 +59,11 @@ import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Types
import qualified Data.Generics.Uniplate.Direct as Uniplate import qualified Data.Generics.Uniplate.Direct as Uniplate
#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import qualified GHC.Hs.Extension as HsExtension
#else
import qualified HsExtension import qualified HsExtension
#endif #endif /* ghc-8.10.1 */
@ -299,11 +301,11 @@ lines' s = case break (== '\n') s of
(s1, [_]) -> [s1, ""] (s1, [_]) -> [s1, ""]
(s1, (_:r)) -> s1 : lines' r (s1, (_:r)) -> s1 : lines' r
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
absurdExt :: HsExtension.NoExtCon -> a
absurdExt = HsExtension.noExtCon
#else
-- | A method to dismiss NoExt patterns for total matches -- | A method to dismiss NoExt patterns for total matches
absurdExt :: HsExtension.NoExt -> a absurdExt :: HsExtension.NoExt -> a
absurdExt = error "cannot construct NoExt" absurdExt = error "cannot construct NoExt"
#else
absurdExt :: ()
absurdExt = ()
#endif #endif

View File

@ -1,12 +0,0 @@
resolver: lts-9.0
extra-deps:
- monad-memo-0.4.1
- czipwith-1.0.1.0
- butcher-1.3.1.1
- data-tree-print-0.1.0.0
- deque-0.2
- ghc-exactprint-0.5.8.0
packages:
- .

View File

@ -1,54 +0,0 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: monad-memo-0.4.1@sha256:d7575b0c89ad21818ca5746170d10a3b92f01fdf9028fa37d3a370e42b24b38b,3672
pantry-tree:
size: 1823
sha256: 8d7bcc8a8bce43804613a160fd7f0fea7869a54e530a9f1b9f9e853ec4e00b57
original:
hackage: monad-memo-0.4.1
- completed:
hackage: czipwith-1.0.1.0@sha256:30751c5a92488304863f20403cd8e9d4fee2b5def0b656a3d979aa3331a09c00,1652
pantry-tree:
size: 323
sha256: acd60968c5a1945741204751243f88d1af1c152018c2d9575f62c0805825f44f
original:
hackage: czipwith-1.0.1.0
- completed:
hackage: butcher-1.3.1.1@sha256:d5734df2e42c28c5a8419eb8251cc531e5f5e6a13794b2ae1dac04abd1c359ad,3242
pantry-tree:
size: 1197
sha256: 057b5c8aa0211951337d87cda1f3d4c6f049945314f6fc7883394eebac79be5b
original:
hackage: butcher-1.3.1.1
- completed:
hackage: data-tree-print-0.1.0.0@sha256:6610723626501d3ab65dc2290c0de59de8d042caf72a1db1e0cd01e84d229346,1547
pantry-tree:
size: 272
sha256: caa741fd498f754b42d45a16aae455056d5e71df51e960fce1579b8e8b6496ad
original:
hackage: data-tree-print-0.1.0.0
- completed:
hackage: deque-0.2@sha256:a9736298cd04472924b3b681b3791c99e8b6009a6e5df1ff13dd57457109ad43,877
pantry-tree:
size: 205
sha256: c48e1f58dfac107ba9dd8d159d4c033fd72521de678204788e3f01f7a2e17546
original:
hackage: deque-0.2
- completed:
hackage: ghc-exactprint-0.5.8.0@sha256:71915a08a7d442d39a63cb3b0fbd90b7dacd19bc4b05bac5c53b6e8a0d931b7b,7728
pantry-tree:
size: 83871
sha256: 3998143d33f7de29b31e8cf8d1b207c1fb4962f819fc820e209e1eecbf7e5a35
original:
hackage: ghc-exactprint-0.5.8.0
snapshots:
- completed:
size: 533451
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/0.yaml
sha256: 27f29b231b39ea68e967a7a4346b2693a49d77c50f41fc0c276e11189a538da7
original: lts-9.0

View File

@ -1,9 +0,0 @@
resolver: lts-11.1
extra-deps:
- czipwith-1.0.1.0
- butcher-1.3.1.1
- ghc-exactprint-0.5.8.0
packages:
- .

View File

@ -1,33 +0,0 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: czipwith-1.0.1.0@sha256:30751c5a92488304863f20403cd8e9d4fee2b5def0b656a3d979aa3331a09c00,1652
pantry-tree:
size: 323
sha256: acd60968c5a1945741204751243f88d1af1c152018c2d9575f62c0805825f44f
original:
hackage: czipwith-1.0.1.0
- completed:
hackage: butcher-1.3.1.1@sha256:d5734df2e42c28c5a8419eb8251cc531e5f5e6a13794b2ae1dac04abd1c359ad,3242
pantry-tree:
size: 1197
sha256: 057b5c8aa0211951337d87cda1f3d4c6f049945314f6fc7883394eebac79be5b
original:
hackage: butcher-1.3.1.1
- completed:
hackage: ghc-exactprint-0.5.8.0@sha256:71915a08a7d442d39a63cb3b0fbd90b7dacd19bc4b05bac5c53b6e8a0d931b7b,7728
pantry-tree:
size: 83871
sha256: 3998143d33f7de29b31e8cf8d1b207c1fb4962f819fc820e209e1eecbf7e5a35
original:
hackage: ghc-exactprint-0.5.8.0
snapshots:
- completed:
size: 505335
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/1.yaml
sha256: 59c853f993e736f430ad20d03eb5441c715d84359c035de906f970841887a8f8
original: lts-11.1

View File

@ -1,4 +0,0 @@
resolver: lts-12.12
extra-deps:
- ghc-exactprint-0.5.8.1

View File

@ -1,19 +0,0 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: ghc-exactprint-0.5.8.1@sha256:f76eed0976b854ce03928796e9cff97769e304618ca99bc0f6cdccab31e539d0,7728
pantry-tree:
size: 83871
sha256: 14febc191ef8b0d1f218d13e8db9ed20395f10a5b3d8aa2c0d45869a037420a2
original:
hackage: ghc-exactprint-0.5.8.1
snapshots:
- completed:
size: 504336
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/12.yaml
sha256: 11db5c37144d13fe6b56cd511050b4e6ffe988f6edb8e439c2432fc9fcdf50c3
original: lts-12.12

View File

@ -1,5 +1 @@
resolver: lts-13.23 resolver: lts-14.27
extra-deps:
- butcher-1.3.2.1
- multistate-0.8.0.1

View File

@ -3,24 +3,10 @@
# For more information, please see the documentation at: # For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files # https://docs.haskellstack.org/en/stable/lock_files
packages: packages: []
- completed:
hackage: butcher-1.3.2.1@sha256:cf479ea83a08f4f59a482e7c023c70714e7c93c1ccd7d53fe076ad3f1a3d2b8d,3115
pantry-tree:
size: 1197
sha256: dc4bd6adc5f8bd3589533659b62567da78b6956d7098e561c0523c60fcaa0406
original:
hackage: butcher-1.3.2.1
- completed:
hackage: multistate-0.8.0.1@sha256:496ac087a0df3984045d7460b981d5e868a49e160b60a6555f6799e81e58542d,3700
pantry-tree:
size: 2143
sha256: 0136d5fcddee0244c3bc73b4ae1b489134a1dd12a8978f437b2be81e98f5d8bd
original:
hackage: multistate-0.8.0.1
snapshots: snapshots:
- completed: - completed:
size: 498398 size: 524996
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/23.yaml url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml
sha256: 63151ca76f39d5cfbd266ce019236459fdda53fbefd2200aedeb33bcc81f808e sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0
original: lts-13.23 original: lts-14.27

1
stack-8.8.4.yaml Normal file
View File

@ -0,0 +1 @@
resolver: lts-16.25

12
stack-8.8.4.yaml.lock Normal file
View File

@ -0,0 +1,12 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
size: 533252
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/25.yaml
sha256: 147598b98bdd95ec0409bac125a4f1bff3cd4f8d73334d283d098f66a4bcc053
original: lts-16.25

View File

@ -1,11 +1,4 @@
resolver: lts-13.25 resolver: nightly-2020-12-09
extra-deps: extra-deps:
- multistate-0.8.0.2 - data-tree-print-0.1.0.2
- butcher-1.3.2.3
- deque-0.4.2.3
- strict-list-0.1.4
- ghc-exactprint-0.6.2
packages:
- .

View File

@ -5,43 +5,15 @@
packages: packages:
- completed: - completed:
hackage: multistate-0.8.0.2@sha256:fbb0d8ade9ef73c8ed92488f5804d0ebe75d3a9c24bf53452bc3a4f32b34cb2e,3713 hackage: data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620
pantry-tree: pantry-tree:
size: 2143 size: 272
sha256: 1753828d37b456e1e0241766d893b29f385ef7769fa79610f507b747935b77cb sha256: b8778eb1b16fddb91b2eed2b25f33a89d1e4f7a533160de4ccbf226f82456135
original: original:
hackage: multistate-0.8.0.2 hackage: data-tree-print-0.1.0.2
- completed:
hackage: butcher-1.3.2.3@sha256:1b8040eddb6da2a05426bf9f6c56b078e629228d64d7d61fb3daa88802487e1b,3262
pantry-tree:
size: 1197
sha256: 6bf3a318bd8689bd1fa7a8084c0d96372768d2dc3e30d9aa58d07741ed6816e6
original:
hackage: butcher-1.3.2.3
- completed:
hackage: deque-0.4.2.3@sha256:7cc8ddfc77df351ff9c16e838ccdb4a89f055c80a3111e27eba8d90e8edde7d0,1853
pantry-tree:
size: 807
sha256: 7f584c71e9e912935f829cb4667411ae3c3048fcd8b935170fb5a45188019403
original:
hackage: deque-0.4.2.3
- completed:
hackage: strict-list-0.1.4@sha256:0fa869e2c21b710b7133e8628169f120fe6299342628edd3d5087ded299bc941,1631
pantry-tree:
size: 340
sha256: bbb22fd014867dc48697ddd8598d4a9fb03fa2d58ef79bed94f208a9b6d94224
original:
hackage: strict-list-0.1.4
- completed:
hackage: ghc-exactprint-0.6.2@sha256:d822f64351e9a8e03d9bad35c8fdf558d30dc396801b396c52b5d5bffaee9108,8368
pantry-tree:
size: 85384
sha256: d904de9c01e58bfa091d7caa09e0423e9d2932b7b3490c4d83140731f4473877
original:
hackage: ghc-exactprint-0.6.2
snapshots: snapshots:
- completed: - completed:
size: 499461 size: 556768
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/25.yaml url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/12/9.yaml
sha256: aed98969628e20615e96b06083c933c7e3354ae56b08b75e607a26569225d6c0 sha256: bca31ebf05f842be9dd24410eca84f296da1860369a82eb7466f447a76cca762
original: lts-13.25 original: nightly-2020-12-09