diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,13 @@ `stan` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.1.0.1 + +* Add support for GHC 9.6 (will only work with `Cabal` library version + 3.10 -- if this causes problems for you please comment on the + corresponding [`extensions` + ticket](https://github.com/kowainik/extensions/issues/89)) + ## 0.1.0.0 * Add support for GHCs 9.0, 9.2 and 9.4 diff --git a/src/Stan/Ghc/Compat.hs b/src/Stan/Ghc/Compat.hs --- a/src/Stan/Ghc/Compat.hs +++ b/src/Stan/Ghc/Compat.hs @@ -10,4 +10,6 @@ import Stan.Ghc.Compat902 as Compat #elif __GLASGOW_HASKELL__ == 904 import Stan.Ghc.Compat902 as Compat +#elif __GLASGOW_HASKELL__ == 906 +import Stan.Ghc.Compat906 as Compat #endif diff --git a/src/Stan/Ghc/Compat810.hs b/src/Stan/Ghc/Compat810.hs --- a/src/Stan/Ghc/Compat810.hs +++ b/src/Stan/Ghc/Compat810.hs @@ -71,5 +71,5 @@ showTUnitId :: UnitId -> Text showTUnitId = T.pack . unitIdString #else - where + () where #endif diff --git a/src/Stan/Ghc/Compat902.hs b/src/Stan/Ghc/Compat902.hs --- a/src/Stan/Ghc/Compat902.hs +++ b/src/Stan/Ghc/Compat902.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Stan.Ghc.Compat902 #if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 @@ -58,7 +61,7 @@ import GHC.Types.Name.Occurrence (isSymOcc, occNameString) import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol, srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc) -import GHC.Types.Var (ArgFlag (..)) +import GHC.Types.Var (ArgFlag (..), Specificity (..)) import qualified Data.Text as T @@ -69,6 +72,9 @@ showTUnitId = T.pack . unitIdString type FieldLbl = FieldLabel + +deriving stock instance Show Specificity => Show ArgFlag + #else () where #endif diff --git a/src/Stan/Ghc/Compat906.hs b/src/Stan/Ghc/Compat906.hs new file mode 100644 --- /dev/null +++ b/src/Stan/Ghc/Compat906.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Stan.Ghc.Compat906 +#if __GLASGOW_HASKELL__ == 906 + ( -- * Modules + Module + , ModuleName + , moduleNameString + , moduleName + , moduleStableString + , moduleUnitId + + -- * Names + , Name + , isExternalName + , isSymOcc + , nameModule + , nameOccName + , nameStableString + , occNameString + + -- * Source locations + , RealSrcSpan + , srcSpanEndCol + , srcSpanStartCol + , srcSpanStartLine + , srcSpanEndLine + , srcSpanFile + , mkRealSrcLoc + , mkRealSrcSpan + + -- * Other common types (for debugging and not only) + , AvailInfo (..) + , FastString + , mkFastString + , FieldLbl + , FieldLabel (..) + , FieldLabelString (..) + , ForAllTyFlag (..) + , IfaceTyCon (..) + , IfaceTyConInfo (..) + , IfaceTyConSort (..) + , IfaceTyLit (..) + , PromotionFlag (..) + , TupleSort (..) + , showTUnitId + ) where + +import GHC.Types.Avail (AvailInfo (..)) +import GHC.Types.Basic (PromotionFlag (..), TupleSort (..)) +import GHC.Data.FastString (FastString, mkFastString) +import GHC.Types.FieldLabel (FieldLabel (..)) +import GHC.Iface.Type (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..)) +import GHC.Unit.Types (Module, moduleName) +import GHC.Unit.Module (moduleStableString) +import GHC.Unit (moduleUnit, toUnitId, UnitId, unitIdString) +import Language.Haskell.Syntax.Module.Name (ModuleName, moduleNameString) +import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import GHC.Types.Name (Name, isExternalName, nameModule, nameOccName, nameStableString) +import GHC.Types.Name.Occurrence (isSymOcc, occNameString) +import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol, + srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc) +import GHC.Types.Var (ForAllTyFlag (..), Specificity (..)) + +moduleUnitId :: Module -> UnitId +moduleUnitId = toUnitId . moduleUnit + +showTUnitId :: UnitId -> Text +showTUnitId = toText . unitIdString + +type FieldLbl = FieldLabel + +deriving stock instance Show Specificity => Show ForAllTyFlag + +deriving stock instance Show FieldLabelString + +#else + () where +#endif diff --git a/src/Stan/Hie.hs b/src/Stan/Hie.hs --- a/src/Stan/Hie.hs +++ b/src/Stan/Hie.hs @@ -16,6 +16,7 @@ ) where import Colourista (errorMessage, infoMessage, warningMessage) +import Prelude hiding (span) import System.Directory (doesDirectoryExist, doesFileExist) import System.Directory.Recursive (getDirRecursive) import System.FilePath (takeExtension) diff --git a/src/Stan/Hie/Compat.hs b/src/Stan/Hie/Compat.hs --- a/src/Stan/Hie/Compat.hs +++ b/src/Stan/Hie/Compat.hs @@ -10,4 +10,6 @@ import Stan.Hie.Compat902 as Compat #elif __GLASGOW_HASKELL__ == 904 import Stan.Hie.Compat904 as Compat +#elif __GLASGOW_HASKELL__ == 906 +import Stan.Hie.Compat904 as Compat #endif diff --git a/src/Stan/Hie/Compat904.hs b/src/Stan/Hie/Compat904.hs --- a/src/Stan/Hie/Compat904.hs +++ b/src/Stan/Hie/Compat904.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Stan.Hie.Compat904 -#if __GLASGOW_HASKELL__ == 904 +#if __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906 ( -- * Main HIE types ContextInfo (..) , HieArgs (..) @@ -63,7 +63,7 @@ mkNodeAnnotation f1 f2 = Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation f1 f2) -data NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation +newtype NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation deriving stock (Eq, Ord) instance Show Stan.Hie.Compat904.NodeAnnotation where diff --git a/src/Stan/Hie/Debug.hs b/src/Stan/Hie/Debug.hs --- a/src/Stan/Hie/Debug.hs +++ b/src/Stan/Hie/Debug.hs @@ -10,4 +10,6 @@ import Stan.Hie.Debug902 as Compat #elif __GLASGOW_HASKELL__ == 904 import Stan.Hie.Debug902 as Compat +#elif __GLASGOW_HASKELL__ == 906 +import Stan.Hie.Debug902 as Compat #endif diff --git a/src/Stan/Hie/Debug902.hs b/src/Stan/Hie/Debug902.hs --- a/src/Stan/Hie/Debug902.hs +++ b/src/Stan/Hie/Debug902.hs @@ -21,14 +21,14 @@ -} module Stan.Hie.Debug902 -#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 +#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906 ( debugHieFile ) where import Text.Pretty.Simple (pPrint) import Stan.Core.ModuleName (fromGhcModule) -import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLabel (..), IfaceTyCon (..), +import Stan.Ghc.Compat (AvailInfo (..), FieldLabel (..), IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module, Name, PromotionFlag (..), TupleSort (..), isExternalName, moduleStableString, moduleUnitId, nameModule, nameOccName, @@ -76,7 +76,6 @@ deriving stock instance Show IfaceTyLit deriving stock instance Show PromotionFlag deriving stock instance Show TupleSort -deriving stock instance Show ArgFlag deriving stock instance Show AvailInfo deriving stock instance Show FieldLabel deriving stock instance Show NodeAnnotation diff --git a/src/Stan/Hie/MatchAst.hs b/src/Stan/Hie/MatchAst.hs --- a/src/Stan/Hie/MatchAst.hs +++ b/src/Stan/Hie/MatchAst.hs @@ -17,7 +17,7 @@ ) where import Data.Char (toLower) - +import Prelude hiding (span) import Stan.Core.List (checkWith) import Stan.Ghc.Compat (nameOccName, occNameString) import Stan.Hie (slice) @@ -54,7 +54,7 @@ hieMatchPatternAst hie node p1 && hieMatchPatternAst hie node p2 PatternAstConstant lit -> - Set.member literalAnns (Set.map toNodeAnnotation (nodeAnnotations nodeInfo)) + Set.member literalAnns (Set.map toNodeAnnotation (nodeAnnotations nodeInfo')) && ( let span = slice nodeSpan hie_hs_src in case lit of ExactNum n -> (span >>= readMaybe . decodeUtf8) == Just n ExactStr s -> span == Just s @@ -65,26 +65,26 @@ PatternAstName nameMeta patType -> any (matchNameAndType nameMeta patType) $ Map.assocs - $ nodeIdentifiers nodeInfo + $ nodeIdentifiers nodeInfo' PatternAstNode tags -> - matchAnnotations tags nodeInfo + matchAnnotations tags nodeInfo' PatternAstNodeExact tags patChildren -> - matchAnnotations tags nodeInfo + matchAnnotations tags nodeInfo' && checkWith (hieMatchPatternAst hie) nodeChildren patChildren PatternAstVarName varName -> isJust $ find (\case Right x -> varName `Str.isInfixOf` map toLower (occNameString $ nameOccName x) Left _ -> False ) - $ Map.keys $ nodeIdentifiers nodeInfo + $ Map.keys $ nodeIdentifiers nodeInfo' PatternAstIdentifierDetailsDecl declType -> any (any (isDecl declType) . identInfo) $ - Map.elems $ nodeIdentifiers nodeInfo + Map.elems $ nodeIdentifiers nodeInfo' where matchAnnotations :: Set NodeAnnotation -> NodeInfo TypeIndex -> Bool matchAnnotations tags NodeInfo{..} = tags `Set.isSubsetOf` Set.map toNodeAnnotation nodeAnnotations - nodeInfo = Stan.Hie.Compat.nodeInfo node + nodeInfo' = Stan.Hie.Compat.nodeInfo node matchNameAndType :: NameMeta @@ -93,7 +93,7 @@ -> Bool matchNameAndType nameMeta patType ids = hieMatchNameMeta nameMeta ids - && case nodeType nodeInfo of + && case nodeType nodeInfo' of [] -> False t : _ -> hieMatchPatternType hie_types patType t diff --git a/src/Stan/Pattern/Ast.hs b/src/Stan/Pattern/Ast.hs --- a/src/Stan/Pattern/Ast.hs +++ b/src/Stan/Pattern/Ast.hs @@ -190,6 +190,7 @@ typeSig :: PatternAst typeSig = PatternAstNode $ one (mkNodeAnnotation "TypeSig" "Sig") +absBinds :: NodeAnnotation absBinds = #if __GLASGOW_HASKELL__ < 904 mkNodeAnnotation "AbsBinds" "HsBindLR" diff --git a/src/Stan/Pattern/Type.hs b/src/Stan/Pattern/Type.hs --- a/src/Stan/Pattern/Type.hs +++ b/src/Stan/Pattern/Type.hs @@ -47,7 +47,8 @@ +---------------------+---------------------------------------------------------------------+ | @a@ | @PatternName (NameMeta ... \"a\") []@ | +---------------------+---------------------------------------------------------------------+ - | @[a]@ | @PatternName (NameMeta ... \"[]\") [aPattern]@ | + | @[a]@ | @PatternName (NameMeta ... \"List\") [aPattern]@ (after GHC 9.6) | + | | @PatternName (NameMeta ... \"[]\") [aPattern]@ (before GHC 9.6) | +---------------------+---------------------------------------------------------------------+ | @Either Int String@ | @PatternName (NameMeta ... \"Either\") [intPattern, stringPattern]@ | +---------------------+---------------------------------------------------------------------+ @@ -96,7 +97,11 @@ "String" `baseNameFrom` "GHC.Base" |:: [] where listNameMeta :: NameMeta +#if __GLASGOW_HASKELL__ < 906 listNameMeta = primTypeMeta "[]" +#elif __GLASGOW_HASKELL__ >= 906 + listNameMeta = primTypeMeta "List" +#endif -- | 'PatternType' for 'NonEmpty'. nonEmptyPattern :: PatternType @@ -106,46 +111,42 @@ listFunPattern :: PatternType listFunPattern = listPattern |-> (?) --- | 'PatternType' for 'Integer'. -integerPattern = +-- The source for integerPattern and naturalPattern varies depending on the GHC +-- version #if __GLASGOW_HASKELL__ < 900 - integerPattern810 -#elif __GLASGOW_HASKELL__ >= 900 - integerPattern900 -#endif --- | 'PatternType' for 'Natural'. -naturalPattern = -#if __GLASGOW_HASKELL__ < 900 - naturalPattern810 -#elif __GLASGOW_HASKELL__ >= 900 - naturalPattern900 -#endif - -integerPattern810 :: PatternType -integerPattern810 = NameMeta +-- | 'PatternType' for 'Integer'. +integerPattern :: PatternType +integerPattern = NameMeta { nameMetaName = "Integer" , nameMetaModuleName = "GHC.Integer.Type" , nameMetaPackage = "integer-wired-in" } |:: [] -integerPattern900 :: PatternType -integerPattern900 = NameMeta +-- | 'PatternType' for 'Natural'. +naturalPattern :: PatternType +naturalPattern = "Natural" `baseNameFrom` "GHC.Natural" |:: [] + +#elif __GLASGOW_HASKELL__ >= 900 + +-- | 'PatternType' for 'Integer'. +integerPattern :: PatternType +integerPattern = NameMeta { nameMetaName = "Integer" , nameMetaModuleName = "GHC.Num.Integer" , nameMetaPackage = "ghc-bignum" } |:: [] -naturalPattern810 :: PatternType -naturalPattern810 = "Natural" `baseNameFrom` "GHC.Natural" |:: [] - -naturalPattern900 :: PatternType -naturalPattern900 = NameMeta +-- | 'PatternType' for 'Natural'. +naturalPattern :: PatternType +naturalPattern = NameMeta { nameMetaName = "Natural" , nameMetaModuleName = "GHC.Num.Natural" , nameMetaPackage = "ghc-bignum" } |:: [] +#endif + charPattern :: PatternType charPattern = primTypeMeta "Char" |:: [] @@ -175,7 +176,13 @@ -- | 'PatternType' for pair @(,)@. pairPattern :: PatternType -pairPattern = "(,)" `ghcPrimNameFrom` "GHC.Tuple" |:: [ (?), (?) ] +pairPattern = "(,)" `ghcPrimNameFrom` ghcTuple |:: [ (?), (?) ] + where +#if __GLASGOW_HASKELL__ < 906 + ghcTuple = "GHC.Tuple" +#elif __GLASGOW_HASKELL__ >= 906 + ghcTuple = "GHC.Tuple.Prim" +#endif {- | Type patterns for the 'Foldable' typeclass methods. Represented as a non-empty list of pairs: diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,15 @@ +resolver: lts-21.15 # GHC 9.4.7 + +extra-deps: +- clay-0.14.0@sha256:a50ba73137a39c55e89f24a7792107ec40ba07320b2c5ff7932049845c50ffc9,2204 +- dir-traverse-0.2.3.0@sha256:adcc128f201ff95131b15ffe41365dc99c50dc3fa3a910f021521dc734013bfa,2137 +- extensions-0.1.0.0@sha256:b8105dc43a57b0b3b54879e8dbb905676dfee3e8b59301fefbf2409a0fe95710,4447 +- hedgehog-1.1.2@sha256:7378b26898f39ec436da93a95112db271384a2fe517bf8323c4e5893ea461b78,4475 +- optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982 +- pretty-simple-4.0.0.0@sha256:a65be4ef40734eae1da7a88c9b73dbf1848f5a60b634dc4776fae60cafc85386,4071 +- primitive-0.7.4.0@sha256:c2f0ed97b3dce97f2f43b239c3be8b136e4368f1eb7b61322ee9ac98f604622b,2982 +- tomland-1.3.3.2@sha256:d18682d9ad9014cc42a12bd122ae7834a950a052a122388995f33d6f349ff60d,9235 +- trial-0.0.0.0@sha256:7946afde7134db6c5c35b7ab611018e2925e9c9fbb8c0fcf9831f3c7020928f1,4416 +- trial-optparse-applicative-0.0.0.0@sha256:92548124f12c746bd30bb19c2e57b8a1bcad5824980f04a387efb0b1487c053c,2478 +- trial-tomland-0.0.0.0@sha256:77f63a62660f94774375b2c1a1b28d25e4791d9bcad05e33dd7597cff0e75beb,2547 +- validation-selective-0.2.0.0@sha256:e847f5aeb078414d22677e6fe1760355ea3bbafc116fa4a9c8bce7f2c3dbcb54,3801 diff --git a/stan.cabal b/stan.cabal --- a/stan.cabal +++ b/stan.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: stan -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Haskell STatic ANalyser description: Stan is a Haskell __ST__atic __AN__alysis CLI tool. @@ -17,6 +17,7 @@ stability: experimental extra-doc-files: README.md CHANGELOG.md + stack.yaml extra-source-files: test/.stan-example.toml tested-with: GHC == 8.8.4 GHC == 8.10.7 @@ -121,6 +122,7 @@ Stan.Ghc.Compat810 Stan.Ghc.Compat900 Stan.Ghc.Compat902 + Stan.Ghc.Compat906 Stan.Hie.Compat810 Stan.Hie.Compat900 Stan.Hie.Compat902 @@ -140,8 +142,8 @@ , directory ^>= 1.3 , extensions ^>= 0.0.0.1 || ^>= 0.1.0.0 , filepath ^>= 1.4 - , ghc >= 8.8 && < 9.5 - , ghc-boot-th >= 8.8 && < 9.5 + , ghc >= 8.8 && < 9.7 + , ghc-boot-th >= 8.8 && < 9.7 , gitrev ^>= 1.3.1 , microaeson ^>= 0.1.0.0 , optparse-applicative >= 0.15 && < 0.17 @@ -199,8 +201,8 @@ , containers , filepath ^>= 1.4 , ghc - , hedgehog >= 1.0 && < 1.2 - , hspec >= 2.7 && < 2.11 + , hedgehog >= 1.0 && < 1.4 + , hspec >= 2.7 && < 2.12 , hspec-hedgehog >= 0.0.1.2 , optparse-applicative , text