diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile new file mode 100644 index 0000000..2328b4d --- /dev/null +++ b/.devcontainer/Dockerfile @@ -0,0 +1,35 @@ +ARG UBUNTU_TAG=20.04 +FROM ubuntu:"$UBUNTU_TAG" + +ENV LANG=C.UTF-8 +RUN \ + apt-get update && \ + apt-get install --assume-yes curl gcc git libgmp-dev libtinfo-dev make sudo + +ARG GHCUP_VERSION=0.1.17.3 +RUN \ + curl --output /usr/local/bin/ghcup "https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/x86_64-linux-ghcup-$GHCUP_VERSION" && \ + chmod +x /usr/local/bin/ghcup && \ + ghcup --version + +ARG USER_NAME=haskell +RUN \ + useradd --create-home --shell "$( which bash )" "$USER_NAME" && \ + echo "$USER_NAME ALL=(ALL) NOPASSWD: ALL" | tee "/etc/sudoers.d/$USER_NAME" +USER "$USER_NAME" +ENV PATH="/home/$USER_NAME/.cabal/bin:/home/$USER_NAME/.ghcup/bin:$PATH" + +ARG GHC_VERSION=9.0.1 +RUN \ + ghcup install ghc "$GHC_VERSION" --set && \ + ghc --version + +ARG CABAL_VERSION=3.6.2.0 +RUN \ + ghcup install cabal "$CABAL_VERSION" --set && \ + cabal --version + +ARG HLS_VERSION=1.4.0 +RUN \ + ghcup install hls "$HLS_VERSION" --set && \ + haskell-language-server-wrapper --version diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json new file mode 100644 index 0000000..582acff --- /dev/null +++ b/.devcontainer/devcontainer.json @@ -0,0 +1,6 @@ +{ + "build": { + "dockerfile": "Dockerfile" + }, + "postCreateCommand": "cabal update" +} diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 0000000..8c8df54 --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,5 @@ +{ + "recommendations": [ + "haskell.haskell" + ] +} diff --git a/brittany.cabal b/brittany.cabal index fa058f4..fb2fe3c 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -91,8 +91,8 @@ library { -fno-warn-redundant-constraints } build-depends: - { base >=4.12 && <4.15 - , ghc >=8.6.1 && <8.11 + { base >=4.12 && <4.16 + , ghc >=8.6.1 && <8.11 || >=9.0 && <9.1 , ghc-paths >=0.1.0.9 && <0.2 , ghc-exactprint >=0.5.8 && <0.6.5 , transformers >=0.5.2.0 && <0.6 @@ -118,7 +118,7 @@ library { , semigroups >=0.18.2 && <0.20 , cmdargs >=0.10.14 && <0.11 , czipwith >=1.0.1.0 && <1.1 - , ghc-boot-th >=8.6.1 && <8.11 + , ghc-boot-th >=8.6.1 && <8.11 || >=9.0 && <9.1 , filepath >=1.4.1.0 && <1.5 , random >= 1.1 && <1.3 } diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..6d724ea --- /dev/null +++ b/cabal.project @@ -0,0 +1,12 @@ +packages: . + +allow-newer: + , butcher:base + , data-tree-print:base + , multistate:base + +-- https://github.com/lspitzner/czipwith/pull/2 +source-repository-package + type: git + location: https://github.com/mithrandi/czipwith + tag: b6245884ae83e00dd2b5261762549b37390179f8 diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index c5d8eb0..46b2ba1 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -340,16 +340,16 @@ data ExactPrintFallbackMode -- A PROGRAM BY TRANSFORMING IT. deriving (Show, Generic, Data) -instance CFunctor CDebugConfig -instance CFunctor CLayoutConfig -instance CFunctor CErrorHandlingConfig -instance CFunctor CForwardOptions -instance CFunctor CPreProcessorConfig -instance CFunctor CConfig - deriveCZipWith ''CDebugConfig deriveCZipWith ''CLayoutConfig deriveCZipWith ''CErrorHandlingConfig deriveCZipWith ''CForwardOptions deriveCZipWith ''CPreProcessorConfig deriveCZipWith ''CConfig + +instance CFunctor CDebugConfig +instance CFunctor CLayoutConfig +instance CFunctor CErrorHandlingConfig +instance CFunctor CForwardOptions +instance CFunctor CPreProcessorConfig +instance CFunctor CConfig diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index 9992dfd..152bd7e 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -20,6 +20,22 @@ import Language.Haskell.Brittany.Internal.Utils import Data.Data import Data.HList.HList +#if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Session ( getDynFlags ) +import GHC ( runGhc, GenLocated(L), moduleNameString ) +import qualified GHC.Driver.Session as GHC +import qualified GHC as GHC hiding (parseModule) +import qualified GHC.Parser as GHC +import qualified GHC.Types.SrcLoc as GHC +import qualified GHC.Data.FastString as GHC +import qualified GHC.Parser.Lexer as GHC +import qualified GHC.Data.StringBuffer as GHC +import qualified GHC.Utils.Outputable as GHC +import qualified GHC.Driver.CmdLine as GHC +import GHC.Hs +import GHC.Data.Bag +import GHC.Types.SrcLoc ( SrcSpan, Located ) +#else import DynFlags ( getDynFlags ) import GHC ( runGhc, GenLocated(L), moduleNameString ) import qualified DynFlags as GHC @@ -41,6 +57,7 @@ import HsSyn #endif import SrcLoc ( SrcSpan, Located ) +#endif import qualified Language.Haskell.GHC.ExactPrint as ExactPrint @@ -153,7 +170,11 @@ commentAnnFixTransformGlob ast = do annsMap = Map.fromListWith (flip const) [ (GHC.realSrcSpanEnd span, annKey) +#if MIN_VERSION_ghc(9,0,0) + | (GHC.RealSrcSpan span _, annKey) <- Foldable.toList nodes +#else | (GHC.RealSrcSpan span, annKey) <- Foldable.toList nodes +#endif ] nodes `forM_` (snd .> processComs annsMap) where @@ -168,9 +189,14 @@ commentAnnFixTransformGlob ast = do :: (ExactPrint.Comment, ExactPrint.DeltaPos) -> ExactPrint.TransformT Identity Bool processCom comPair@(com, _) = +#if MIN_VERSION_ghc(9,0,0) + case GHC.realSrcSpanStart $ ExactPrint.commentIdentifier com of + comLoc -> case Map.lookupLE comLoc annsMap of +#else case GHC.srcSpanStart $ ExactPrint.commentIdentifier com of GHC.UnhelpfulLoc{} -> return True -- retain comment at current node. GHC.RealSrcLoc comLoc -> case Map.lookupLE comLoc annsMap of +#endif Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of (ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") -> move $> False @@ -179,8 +205,13 @@ commentAnnFixTransformGlob ast = do where ExactPrint.AnnKey annKeyLoc1 con1 = annKey1 ExactPrint.AnnKey annKeyLoc2 con2 = annKey2 +#if MIN_VERSION_ghc(9,0,0) + loc1 = GHC.realSrcSpanStart annKeyLoc1 + loc2 = GHC.realSrcSpanStart annKeyLoc2 +#else loc1 = GHC.srcSpanStart annKeyLoc1 loc2 = GHC.srcSpanStart annKeyLoc2 +#endif move = ExactPrint.modifyAnnsT $ \anns -> let ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns @@ -271,12 +302,20 @@ moveTrailingComments astFrom astTo = do -- elements to the relevant annotations. Avoids quadratic behaviour a trivial -- implementation would have. extractToplevelAnns +#if MIN_VERSION_ghc(9,0,0) + :: Located HsModule +#else :: Located (HsModule GhcPs) +#endif -> ExactPrint.Anns -> Map ExactPrint.AnnKey ExactPrint.Anns extractToplevelAnns lmod anns = output where +#if MIN_VERSION_ghc(9,0,0) + (L _ (HsModule _ _ _ _ ldecls _ _)) = lmod +#else (L _ (HsModule _ _ _ ldecls _ _)) = lmod +#endif declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey declMap1 = Map.unions $ ldecls <&> \ldecl -> Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 770cbdd..12b07f2 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -99,6 +99,15 @@ import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.ExactPrintUtils +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Name.Reader ( RdrName(..) ) +import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) +import qualified GHC.Types.SrcLoc as GHC +import GHC.Types.Name.Occurrence ( occNameString ) +import GHC.Types.Name ( getOccString ) +import GHC ( moduleName ) +import GHC.Parser.Annotation ( AnnKeywordId(..) ) +#else import RdrName ( RdrName(..) ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) import qualified SrcLoc as GHC @@ -106,6 +115,7 @@ import OccName ( occNameString ) import Name ( getOccString ) import Module ( moduleName ) import ApiAnnotation ( AnnKeywordId(..) ) +#endif import Data.Data import Data.Generics.Schemes @@ -299,7 +309,13 @@ filterAnns ast = -- b) after (in source code order) the node. hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool hasAnyCommentsBelow ast@(L l _) = +#if MIN_VERSION_ghc(9,0,0) + case l of + GHC.RealSrcSpan rss _ -> List.any (\(c, _) -> ExactPrint.commentIdentifier c > rss) + GHC.UnhelpfulSpan _ -> const False +#else List.any (\(c, _) -> ExactPrint.commentIdentifier c > l) +#endif <$> astConnectedComments ast hasCommentsBetween diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 3437fcd..1ba7e0b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -30,10 +30,17 @@ import GHC.Hs #else import HsSyn #endif +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Name +import GHC.Utils.Outputable ( ftext, showSDocUnsafe ) +import GHC.Types.Basic +import qualified GHC.Types.SrcLoc +#else import Name import Outputable ( ftext, showSDocUnsafe ) import BasicTypes import qualified SrcLoc +#endif import DataTreePrint @@ -56,7 +63,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] NotPromoted -> docWrapNode name $ docLit t #if MIN_VERSION_ghc(8,10,1) +#if MIN_VERSION_ghc(9,0,0) + HsForAllTy _ tele (L _ (HsQualTy _ (L _ cntxts) typ2)) -> let bndrs = hsf_vis_bndrs tele in do +#else HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do +#endif #else HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do #endif @@ -146,7 +157,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ) ] #if MIN_VERSION_ghc(8,10,1) +#if MIN_VERSION_ghc(9,0,0) + HsForAllTy _ tele typ2 -> let bndrs = hsf_vis_bndrs tele in do +#else HsForAllTy _ _ bndrs typ2 -> do +#endif #else HsForAllTy _ bndrs typ2 -> do #endif @@ -254,7 +269,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] +#if MIN_VERSION_ghc(9,0,0) + HsFunTy _ _ typ1 typ2 -> do +#else HsFunTy _ typ1 typ2 -> do +#endif typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc2 <- docSharedWrapper layoutType typ2 let maybeForceML = case typ2 of @@ -642,11 +661,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of #endif layoutTyVarBndrs +#if MIN_VERSION_ghc(9,0,0) + :: [LHsTyVarBndr flag GhcPs] +#else :: [LHsTyVarBndr GhcPs] +#endif -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))] layoutTyVarBndrs = mapM $ \case +#if MIN_VERSION_ghc(9,0,0) + (L _ (UserTyVar _ _ name)) -> return $ (lrdrNameToText name, Nothing) + (L _ (KindedTyVar _ _ lrdrName kind)) -> do +#else (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) (L _ (KindedTyVar _ lrdrName kind)) -> do +#endif d <- docSharedWrapper layoutType kind return $ (lrdrNameToText lrdrName, Just $ d) (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" diff --git a/src/Language/Haskell/Brittany/Internal/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs index b33e339..dab846a 100644 --- a/src/Language/Haskell/Brittany/Internal/Prelude.hs +++ b/src/Language/Haskell/Brittany/Internal/Prelude.hs @@ -14,8 +14,16 @@ import GHC.Hs.Extension as E ( GhcPs ) import HsExtension as E ( GhcPs ) #endif /* ghc-8.10.1 */ +#if MIN_VERSION_ghc(9,0,0) +import GHC.Types.Name.Reader as E ( RdrName ) +#else import RdrName as E ( RdrName ) -#if MIN_VERSION_ghc(8,8,0) +#endif + +#if MIN_VERSION_ghc(9,0,0) +-- Does not exist in GHC >= 9.0.1. +-- https://gitlab.haskell.org/ghc/ghc/-/issues/17494 +#elif MIN_VERSION_ghc(8,8,0) import qualified GHC ( dL, HasSrcSpan, SrcSpanLess ) #endif import qualified GHC ( Located ) @@ -404,7 +412,10 @@ todo :: a todo = error "todo" -#if MIN_VERSION_ghc(8,8,0) +#if MIN_VERSION_ghc(9,0,0) +ghcDL :: a -> a +ghcDL = id +#elif MIN_VERSION_ghc(8,8,0) ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a) ghcDL = GHC.dL #else /* ghc-8.6 */ diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs index 5ee7ed2..ce2976a 100644 --- a/src/Language/Haskell/Brittany/Internal/Utils.hs +++ b/src/Language/Haskell/Brittany/Internal/Utils.hs @@ -46,11 +46,20 @@ import Data.Generics.Aliases import qualified Text.PrettyPrint as PP import Text.PrettyPrint ( ($+$), (<+>) ) +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Utils.Outputable as GHC +import qualified GHC.Driver.Session as GHC +import qualified GHC.Data.FastString as GHC +import qualified GHC.Types.SrcLoc as GHC +import GHC.Types.Name.Occurrence as OccName ( occNameString ) +#else import qualified Outputable as GHC import qualified DynFlags as GHC import qualified FastString as GHC import qualified SrcLoc as GHC import OccName ( occNameString ) +#endif + import qualified Data.ByteString as B import DataTreePrint diff --git a/stack.yaml b/stack.yaml index 9989a09..0f28446 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,18 @@ -resolver: nightly-2020-12-09 +resolver: nightly-2021-10-20 extra-deps: - - data-tree-print-0.1.0.2 +- butcher-1.3.3.2@sha256:0be5b914f648ec9c63cb88730d983602aef829a7c8c31343952e4642e6b52a84,3150 +- data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 +- multistate-0.8.0.3@sha256:49d600399f3a4bfd8c8ba2e924c6592e84915b63c52970818982baa274cd9ac3,3588 + +# https://github.com/lspitzner/czipwith/pull/2 +- git: https://github.com/mithrandi/czipwith + commit: b6245884ae83e00dd2b5261762549b37390179f8 + +# In the dependencies for butcher-1.3.3.2: +# base-4.15.0.0 from stack configuration does not match >=4.11 && <4.15 +# In the dependencies for data-tree-print-0.1.0.2: +# base-4.15.0.0 from stack configuration does not match >=4.8 && <4.15 +# In the dependencies for multistate-0.8.0.3: +# base-4.15.0.0 from stack configuration does not match >=4.11 && <4.15 +allow-newer: true diff --git a/stack.yaml.lock b/stack.yaml.lock index 91c9355..c621f88 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,16 +4,41 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: +- completed: + hackage: butcher-1.3.3.2@sha256:0be5b914f648ec9c63cb88730d983602aef829a7c8c31343952e4642e6b52a84,3150 + pantry-tree: + size: 1197 + sha256: 96fe696234de07e4d9253d80ddf189f8cfaf2e262e977438343a6069677a39d2 + original: + hackage: butcher-1.3.3.2@sha256:0be5b914f648ec9c63cb88730d983602aef829a7c8c31343952e4642e6b52a84,3150 - completed: hackage: data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 pantry-tree: size: 272 sha256: b8778eb1b16fddb91b2eed2b25f33a89d1e4f7a533160de4ccbf226f82456135 original: - hackage: data-tree-print-0.1.0.2 + hackage: data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 +- completed: + hackage: multistate-0.8.0.3@sha256:49d600399f3a4bfd8c8ba2e924c6592e84915b63c52970818982baa274cd9ac3,3588 + pantry-tree: + size: 2143 + sha256: 73b47c11a753963b033b79209a66490013da35854dd1064b3633dd23c3fa5650 + original: + hackage: multistate-0.8.0.3@sha256:49d600399f3a4bfd8c8ba2e924c6592e84915b63c52970818982baa274cd9ac3,3588 +- completed: + name: czipwith + version: 1.0.1.3 + git: https://github.com/mithrandi/czipwith + pantry-tree: + size: 964 + sha256: 239a37e26558e6272c07dc280ee07a83407ed6b86000047ddb979726c23818c4 + commit: b6245884ae83e00dd2b5261762549b37390179f8 + original: + git: https://github.com/mithrandi/czipwith + commit: b6245884ae83e00dd2b5261762549b37390179f8 snapshots: - completed: - size: 556768 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/12/9.yaml - sha256: bca31ebf05f842be9dd24410eca84f296da1860369a82eb7466f447a76cca762 - original: nightly-2020-12-09 + size: 589241 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/10/20.yaml + sha256: 69b52866fbe539d7de306ef34c4482323f7b846e0d7348188152dea980a11547 + original: nightly-2021-10-20