From 75a1dd6622b975680d4b3d8c9b7018e5d87fd128 Mon Sep 17 00:00:00 2001 From: Tom Ellis Date: Fri, 30 Sep 2022 11:44:47 +0100 Subject: [PATCH] Support up to and including GHC 9.4 --- .github/workflows/ci.yml | 21 +++++- src/Stan/Analysis/Analyser.hs | 6 +- src/Stan/Ghc/Compat.hs | 72 ++++-------------- src/Stan/Ghc/Compat810.hs | 75 +++++++++++++++++++ src/Stan/Ghc/Compat900.hs | 80 ++++++++++++++++++++ src/Stan/Ghc/Compat902.hs | 74 +++++++++++++++++++ src/Stan/Hie.hs | 21 +++--- src/Stan/Hie/Compat.hs | 54 ++++---------- src/Stan/Hie/Compat810.hs | 77 +++++++++++++++++++ src/Stan/Hie/Compat900.hs | 97 ++++++++++++++++++++++++ src/Stan/Hie/Compat902.hs | 115 +++++++++++++++++++++++++++++ src/Stan/Hie/Compat904.hs | 103 ++++++++++++++++++++++++++ src/Stan/Hie/Debug.hs | 93 ++++------------------- src/Stan/Hie/Debug810.hs | 84 +++++++++++++++++++++ src/Stan/Hie/Debug900.hs | 102 +++++++++++++++++++++++++ src/Stan/Hie/Debug902.hs | 102 +++++++++++++++++++++++++ src/Stan/Hie/MatchAst.hs | 16 ++-- src/Stan/Hie/MatchType.hs | 5 +- src/Stan/Inspection/Partial.hs | 6 ++ src/Stan/NameMeta.hs | 6 +- src/Stan/Pattern/Ast.hs | 82 ++++++++++---------- src/Stan/Pattern/Type.hs | 40 ++++++++-- src/Stan/Report/Css.hs | 13 +++- stack.yaml | 1 + stan.cabal | 35 ++++++--- test/Spec.hs | 2 +- test/Test/Stan/Analysis.hs | 2 +- test/Test/Stan/Analysis/Common.hs | 3 +- test/Test/Stan/Analysis/Partial.hs | 4 +- test/Test/Stan/Number.hs | 2 +- test/Test/Stan/Observation.hs | 2 +- 31 files changed, 1122 insertions(+), 273 deletions(-) create mode 100644 src/Stan/Ghc/Compat810.hs create mode 100644 src/Stan/Ghc/Compat900.hs create mode 100644 src/Stan/Ghc/Compat902.hs create mode 100644 src/Stan/Hie/Compat810.hs create mode 100644 src/Stan/Hie/Compat900.hs create mode 100644 src/Stan/Hie/Compat902.hs create mode 100644 src/Stan/Hie/Compat904.hs create mode 100644 src/Stan/Hie/Debug810.hs create mode 100644 src/Stan/Hie/Debug900.hs create mode 100644 src/Stan/Hie/Debug902.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 3d7f8b2b..0d2c9ea3 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,12 +14,22 @@ jobs: name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} runs-on: ${{ matrix.os }} strategy: + fail-fast: false matrix: os: [ubuntu-latest, macOS-latest, windows-latest] - cabal: ["3.2"] + cabal: ["3.8"] ghc: - "8.8.4" - "8.10.4" + - "9.0.1" + - "9.0.2" + - "9.2.1" + - "9.4.1" + - "9.4.2" + - "9.4.4" + - "9.4.5" + - "9.4.6" + - "9.4.7" exclude: - os: macOS-latest ghc: 8.8.4 @@ -28,13 +38,17 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: haskell/actions/setup@v2.0.1 + - uses: haskell/actions/setup@v2.4.6 id: setup-haskell-cabal name: Setup Haskell with: ghc-version: ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} + - name: Configure + run: | + cabal configure --enable-tests --enable-benchmarks --test-show-details=direct + - name: Freeze run: | cabal freeze @@ -47,7 +61,6 @@ jobs: - name: Build run: | - cabal configure --enable-tests --enable-benchmarks --test-show-details=direct cabal build all - name: Test @@ -108,7 +121,7 @@ jobs: - name: Run HLint env: - HLINT_VERSION: "3.2.7" + HLINT_VERSION: "3.6.1" run: | curl https://raw.githubusercontent.com/kowainik/relude/v1.0.0.1/.hlint.yaml -o .hlint-relude.yaml diff --git a/src/Stan/Analysis/Analyser.hs b/src/Stan/Analysis/Analyser.hs index 71701e0a..b3f73b5d 100644 --- a/src/Stan/Analysis/Analyser.hs +++ b/src/Stan/Analysis/Analyser.hs @@ -22,7 +22,7 @@ import Stan.Core.List (nonRepeatingPairs) import Stan.FileInfo (isExtensionDisabled) import Stan.Ghc.Compat (RealSrcSpan, isSymOcc, nameOccName, occNameString) import Stan.Hie (eqAst) -import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex) +import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex, nodeInfo) import Stan.Hie.MatchAst (hieMatchPatternAst) import Stan.Inspection (Inspection (..), InspectionAnalysis (..)) import Stan.NameMeta (NameMeta, ghcPrimNameFrom) @@ -331,10 +331,10 @@ analyseInfix hie curNode = do Right name -> [toText $ occNameString $ nameOccName name] extractOperatorName :: HieAST TypeIndex -> [(Text, RealSrcSpan)] - extractOperatorName Node{..} = + extractOperatorName n@Node{..} = concatMap (topLevelOperatorName nodeSpan) $ Map.keys - $ nodeIdentifiers nodeInfo + $ nodeIdentifiers (Stan.Hie.Compat.nodeInfo n) topLevelOperatorName :: RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)] topLevelOperatorName srcSpan = \case diff --git a/src/Stan/Ghc/Compat.hs b/src/Stan/Ghc/Compat.hs index 026475e0..e9e091cd 100644 --- a/src/Stan/Ghc/Compat.hs +++ b/src/Stan/Ghc/Compat.hs @@ -1,59 +1,13 @@ -{- | -Copyright: (c) 2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik - -Compatibility module for GHC types and functions. Reexports all -required API to work with the GHC API. --} - -module Stan.Ghc.Compat - ( -- * Modules - Module - , ModuleName - , moduleNameString - , moduleName - , moduleStableString - , moduleUnitId - - -- * Names - , Name - , isExternalName - , isSymOcc - , nameModule - , nameOccName - , nameStableString - , occNameString - - -- * Source locations - , RealSrcSpan - , srcSpanEndCol - , srcSpanStartCol - , srcSpanStartLine - , srcSpanEndLine - , srcSpanFile - - -- * Other common types (for debugging and not only) - , ArgFlag (..) - , AvailInfo (..) - , FastString - , FieldLbl (..) - , IfaceTyCon (..) - , IfaceTyConInfo (..) - , IfaceTyConSort (..) - , IfaceTyLit (..) - , PromotionFlag (..) - , TupleSort (..) - ) where - -import Avail (AvailInfo (..)) -import BasicTypes (PromotionFlag (..), TupleSort (..)) -import FastString (FastString) -import FieldLabel (FieldLbl (..)) -import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..)) -import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId) -import Name (Name, isExternalName, nameModule, nameOccName, nameStableString) -import OccName (isSymOcc, occNameString) -import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol, - srcSpanStartLine) -import Var (ArgFlag (..)) +{-# LANGUAGE CPP #-} + +module Stan.Ghc.Compat (module Compat) where + +#if __GLASGOW_HASKELL__ <= 810 +import Stan.Ghc.Compat810 as Compat +#elif __GLASGOW_HASKELL__ == 900 +import Stan.Ghc.Compat900 as Compat +#elif __GLASGOW_HASKELL__ == 902 +import Stan.Ghc.Compat902 as Compat +#elif __GLASGOW_HASKELL__ == 904 +import Stan.Ghc.Compat902 as Compat +#endif diff --git a/src/Stan/Ghc/Compat810.hs b/src/Stan/Ghc/Compat810.hs new file mode 100644 index 00000000..2ef1f595 --- /dev/null +++ b/src/Stan/Ghc/Compat810.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE CPP #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Compatibility module for GHC types and functions. Reexports all +required API to work with the GHC API. +-} + +module Stan.Ghc.Compat810 +#if __GLASGOW_HASKELL__ <= 810 + ( -- * 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) + , ArgFlag (..) + , AvailInfo (..) + , FastString + , mkFastString + , FieldLbl (..) + , IfaceTyCon (..) + , IfaceTyConInfo (..) + , IfaceTyConSort (..) + , IfaceTyLit (..) + , PromotionFlag (..) + , TupleSort (..) + , showTUnitId + ) where + +import Avail (AvailInfo (..)) +import BasicTypes (PromotionFlag (..), TupleSort (..)) +import FastString (FastString, mkFastString) +import FieldLabel (FieldLbl (..)) +import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..)) +import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId, + UnitId, unitIdString) +import Name (Name, isExternalName, nameModule, nameOccName, nameStableString) +import OccName (isSymOcc, occNameString) +import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol, + srcSpanStartLine, mkRealSrcLoc, mkRealSrcSpan) +import Var (ArgFlag (..)) + +import qualified Data.Text as T + +showTUnitId :: UnitId -> Text +showTUnitId = T.pack . unitIdString +#else + where +#endif diff --git a/src/Stan/Ghc/Compat900.hs b/src/Stan/Ghc/Compat900.hs new file mode 100644 index 00000000..5c654fd4 --- /dev/null +++ b/src/Stan/Ghc/Compat900.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE CPP #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Compatibility module for GHC types and functions. Reexports all +required API to work with the GHC API. +-} + +module Stan.Ghc.Compat900 +#if __GLASGOW_HASKELL__ == 900 + ( -- * 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) + , ArgFlag (..) + , AvailInfo (..) + , FastString + , mkFastString + , FieldLbl (..) + , 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 (FieldLbl (..)) +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 GHC.Unit.Module.Name (ModuleName, moduleNameString) +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 (ArgFlag (..)) + +import qualified Data.Text as T + +moduleUnitId :: Module -> UnitId +moduleUnitId = toUnitId . moduleUnit + +showTUnitId :: UnitId -> Text +showTUnitId = T.pack . unitIdString +#else + () where +#endif diff --git a/src/Stan/Ghc/Compat902.hs b/src/Stan/Ghc/Compat902.hs new file mode 100644 index 00000000..e3e78a70 --- /dev/null +++ b/src/Stan/Ghc/Compat902.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE CPP #-} + +module Stan.Ghc.Compat902 +#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 + ( -- * 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) + , ArgFlag (..) + , AvailInfo (..) + , FastString + , mkFastString + , FieldLbl + , FieldLabel (..) + , 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 GHC.Unit.Module.Name (ModuleName, moduleNameString) +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 (ArgFlag (..)) + +import qualified Data.Text as T + +moduleUnitId :: Module -> UnitId +moduleUnitId = toUnitId . moduleUnit + +showTUnitId :: UnitId -> Text +showTUnitId = T.pack . unitIdString + +type FieldLbl = FieldLabel +#else + () where +#endif diff --git a/src/Stan/Hie.hs b/src/Stan/Hie.hs index e9437e71..f5393146 100644 --- a/src/Stan/Hie.hs +++ b/src/Stan/Hie.hs @@ -22,8 +22,9 @@ import System.FilePath (takeExtension) import Stan.Core.List (checkWith) import Stan.Ghc.Compat (RealSrcSpan, srcSpanEndCol, srcSpanStartCol, srcSpanStartLine) -import Stan.Hie.Compat (HieAST (..), HieFile (..), HieFileResult (hie_file_result), NameCache, - NodeInfo (..), initNameCache, mkSplitUniqSupply, readHieFile) +import Stan.Hie.Compat (HieAST (..), HieFile (..), HieFileResult (hie_file_result), + NodeInfo (..), readHieFileWithNameCache, nodeInfo, + toNodeAnnotation) import Stan.Hie.Debug () import Stan.Pattern.Ast (literalAnns) @@ -42,7 +43,7 @@ readHieFiles hieDir = do infoMessage "Use the '--hiedir' CLI option to specify path to the directory with HIE files" exitFailure - nameCache <- createNameCache + readHieFile <- readHieFileWithNameCache hieContent <- getDirRecursive hieDir let isHieFile f = (&&) (takeExtension f == ".hie") <$> doesFileExist f hiePaths <- filterM isHieFile hieContent @@ -51,14 +52,9 @@ readHieFiles hieDir = do "The directory with HIE files doesn't contain any HIE files: " <> toText hieDir forM hiePaths $ \hiePath -> do - (hieFileResult, _newCache) <- readHieFile nameCache hiePath + hieFileResult <- readHieFile hiePath pure $ hie_file_result hieFileResult -createNameCache :: IO NameCache -createNameCache = do - uniqSupply <- mkSplitUniqSupply 'z' - pure $ initNameCache uniqSupply [] - -- | Get the number of lines of code in the file by analising 'HieFile'. countLinesOfCode :: HieFile -> Int countLinesOfCode HieFile{..} = length $ BS8.lines hie_hs_src @@ -91,12 +87,15 @@ eqAst :: forall a . Eq a => HieFile -> HieAST a -> HieAST a -> Bool eqAst HieFile{..} = eqNodes where eqNodes :: HieAST a -> HieAST a -> Bool - eqNodes (Node info1 span1 children1) (Node info2 span2 children2) = + eqNodes n1@(Node _ span1 children1) n2@(Node _ span2 children2) = eqInfo info1 info2 && checkWith eqNodes children1 children2 where + info1 = nodeInfo n1 + info2 = nodeInfo n2 + eqInfo :: NodeInfo a -> NodeInfo a -> Bool eqInfo (NodeInfo anns1 types1 ids1) (NodeInfo anns2 types2 ids2) = anns1 == anns2 && types1 == types2 && ids1 == ids2 && - if Set.member literalAnns anns1 + if Set.member literalAnns (Set.map toNodeAnnotation anns1) then slice span1 hie_hs_src == slice span2 hie_hs_src else True diff --git a/src/Stan/Hie/Compat.hs b/src/Stan/Hie/Compat.hs index 21382482..64ecab77 100644 --- a/src/Stan/Hie/Compat.hs +++ b/src/Stan/Hie/Compat.hs @@ -1,41 +1,13 @@ -{- | -Copyright: (c) 2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik - -Compatibility module for HIE types from GHC API. Reexports all -required API to work with HIE types. --} - -module Stan.Hie.Compat - ( -- * Main HIE types - ContextInfo (..) - , HieArgs (..) - , HieAST (..) - , HieASTs (..) - , HieFile (..) - , HieType (..) - , HieTypeFlat - , IEType (..) - , Identifier - , IdentifierDetails (..) - , NodeInfo (..) - , TypeIndex - , DeclType (..) - - -- * Binary interface to hie files - , HieFileResult (hie_file_result) - , readHieFile - - -- * Name cache to read HIE files - , NameCache - , initNameCache - , mkSplitUniqSupply - ) where - -import HieBin (HieFileResult (hie_file_result), readHieFile) -import HieTypes (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), - HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex) -import NameCache (NameCache, initNameCache) -import UniqSupply (mkSplitUniqSupply) +{-# LANGUAGE CPP #-} + +module Stan.Hie.Compat (module Compat) where + +#if __GLASGOW_HASKELL__ <= 810 +import Stan.Hie.Compat810 as Compat +#elif __GLASGOW_HASKELL__ == 900 +import Stan.Hie.Compat900 as Compat +#elif __GLASGOW_HASKELL__ == 902 +import Stan.Hie.Compat902 as Compat +#elif __GLASGOW_HASKELL__ == 904 +import Stan.Hie.Compat904 as Compat +#endif diff --git a/src/Stan/Hie/Compat810.hs b/src/Stan/Hie/Compat810.hs new file mode 100644 index 00000000..84e01dec --- /dev/null +++ b/src/Stan/Hie/Compat810.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE CPP #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Compatibility module for HIE types from GHC API. Reexports all +required API to work with HIE types. +-} + +module Stan.Hie.Compat810 +#if __GLASGOW_HASKELL__ <= 810 + ( -- * Main HIE types + ContextInfo (..) + , HieArgs (..) + , HieAST (..) + , HieASTs (..) + , HieFile (..) + , HieType (..) + , HieTypeFlat + , IEType (..) + , Identifier + , IdentifierDetails (..) + , NodeInfo (..) + , TypeIndex + , DeclType (..) + , hFunTy2 + , conDec + , eqDeclType + + , NodeAnnotation + , mkNodeAnnotation + , toNodeAnnotation + + -- * Binary interface to hie files + , HieFileResult (hie_file_result) + , readHieFileWithNameCache + ) where + +import HieBin (HieFileResult (hie_file_result), readHieFile) +import HieTypes (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), + HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, + IdentifierDetails (..), NodeInfo (..), TypeIndex) +import NameCache (initNameCache) +import UniqSupply (mkSplitUniqSupply) +import FastString (FastString) + +type NodeAnnotation = (FastString, FastString) + +mkNodeAnnotation :: FastString -> FastString -> NodeAnnotation +mkNodeAnnotation = (,) + +toNodeAnnotation :: NodeAnnotation -> NodeAnnotation +toNodeAnnotation = id + +-- For forward compatibility: the two-argument function type +-- constructor. +hFunTy2 :: HieType b -> Maybe (b, b) +hFunTy2 t = case t of + HFunTy i1 i2 -> Just (i1, i2) + _ -> Nothing + +readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult) +readHieFileWithNameCache = do + uniqSupply <- mkSplitUniqSupply 'z' + let nameCache = initNameCache uniqSupply [] + pure (fmap fst . readHieFile nameCache) + +conDec :: DeclType +conDec = ConDec + +eqDeclType :: DeclType -> DeclType -> Bool +eqDeclType d1 d2 = d1 == d2 +#else + () where +#endif diff --git a/src/Stan/Hie/Compat900.hs b/src/Stan/Hie/Compat900.hs new file mode 100644 index 00000000..6699b1b4 --- /dev/null +++ b/src/Stan/Hie/Compat900.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE CPP #-} + +module Stan.Hie.Compat900 +#if __GLASGOW_HASKELL__ == 900 + ( -- * Main HIE types + ContextInfo (..) + , HieArgs (..) + , HieAST (..) + , HieASTs (..) + , HieFile (..) + , HieType (..) + , HieTypeFlat + , IEType (..) + , Identifier + , IdentifierDetails (..) + , NodeInfo (..) + , TypeIndex + , Stan.Hie.Compat900.DeclType (..) + , hFunTy2 + , conDec + , eqDeclType + + , NodeAnnotation + , mkNodeAnnotation + , toNodeAnnotation + + -- * Binary interface to hie files + , HieFileResult (hie_file_result) + , readHieFileWithNameCache + , nodeInfo + ) where + +import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile) +import GHC.Iface.Ext.Types + (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), + HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, + IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + getSourcedNodeInfo) +import GHC.Types.Name.Cache (initNameCache) +import GHC.Types.Unique.Supply (mkSplitUniqSupply) +import GHC.Data.FastString (FastString) +import GHC.Iface.Env (NameCacheUpdater(NCU)) +import GHC.Utils.Outputable (ppr, showSDocUnsafe) + +import qualified Data.Map.Strict as Map + +import Text.Show (show) + +-- It's not clear if this is completely correct, or whether +-- +-- 1. we should merge in the GeneratedInfo, and/or +-- 2. return a NodeInfo with empty fields when the SourceInfo is empty +-- +-- It works though. +nodeInfo :: HieAST a -> NodeInfo a +nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of + (Nothing, Nothing) -> error "nodeInfo" + (Just n1, Nothing) -> n1 + (Nothing, Just{}) -> error "nodeInfo" + (Just n1, Just{}) -> n1 + where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h)) + +type NodeAnnotation = (FastString, FastString) + +mkNodeAnnotation :: FastString -> FastString -> NodeAnnotation +mkNodeAnnotation = (,) + +toNodeAnnotation :: NodeAnnotation -> NodeAnnotation +toNodeAnnotation = id + +-- For forward compatibility: the two-argument function type +-- constructor. +hFunTy2 :: HieType b -> Maybe (b, b) +hFunTy2 t = case t of + HFunTy _multiplicity i1 i2 -> Just (i1, i2) + _ -> Nothing + +readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult) +readHieFileWithNameCache = do + uniqSupply <- mkSplitUniqSupply 'z' + let nameCache = initNameCache uniqSupply [] + pure (readHieFile (NCU (\f -> pure $ snd $ f nameCache))) + +newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType + deriving stock Eq + +instance Show Stan.Hie.Compat900.DeclType where + show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d)) + +conDec :: Stan.Hie.Compat900.DeclType +conDec = DeclType ConDec + +eqDeclType :: Stan.Hie.Compat900.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool +eqDeclType (DeclType d1) d2 = d1 == d2 +#else + () where +#endif diff --git a/src/Stan/Hie/Compat902.hs b/src/Stan/Hie/Compat902.hs new file mode 100644 index 00000000..566f32ec --- /dev/null +++ b/src/Stan/Hie/Compat902.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE CPP #-} + +module Stan.Hie.Compat902 +#if __GLASGOW_HASKELL__ == 902 + ( -- * Main HIE types + ContextInfo (..) + , HieArgs (..) + , HieAST (..) + , HieASTs (..) + , HieFile (..) + , HieType (..) + , HieTypeFlat + , IEType (..) + , Identifier + , IdentifierDetails (..) + , NodeInfo (..) + , TypeIndex + , Stan.Hie.Compat902.DeclType (..) + , hFunTy2 + , conDec + , eqDeclType + , Stan.Hie.Compat902.NodeAnnotation + , mkNodeAnnotation + , toNodeAnnotation + + -- * Binary interface to hie files + , HieFileResult (hie_file_result) + , readHieFileWithNameCache + , nodeInfo + ) where + +import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile) +import GHC.Iface.Ext.Types + (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), + HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, + IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + getSourcedNodeInfo, NodeAnnotation(..)) +import GHC.Types.Name.Cache (initNameCache) +import GHC.Types.Unique.Supply (mkSplitUniqSupply) +import GHC.Data.FastString (FastString) +import GHC.Iface.Env (NameCacheUpdater(NCU)) +import GHC.Utils.Outputable (ppr, showSDocUnsafe) + +import qualified Data.Map.Strict as Map + +import Text.Show (show) + +-- It's not clear if this is completely correct, or whether +-- +-- 1. we should merge in the GeneratedInfo, and/or +-- 2. return a NodeInfo with empty fields when the SourceInfo is empty +-- +-- It works though. +nodeInfo :: HieAST a -> NodeInfo a +nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of + (Nothing, Nothing) -> error "nodeInfo" + (Just n1, Nothing) -> n1 + (Nothing, Just{}) -> error "nodeInfo" + (Just n1, Just{}) -> n1 + where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h)) + +mkNodeAnnotation :: FastString + -> FastString + -> Stan.Hie.Compat902.NodeAnnotation +mkNodeAnnotation f1 f2 = + Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation f1 f2) + +data NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation + deriving stock Eq + +-- This is a horrendous hack for 9.2 +-- Fixed later by ghc 418295eab741fd420c6f350141c332ef26f9f0a4 I think +instance Ord Stan.Hie.Compat902.NodeAnnotation where + compare + (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2)) + (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation b1 b2)) = + let s = Text.Show.show + in compare (s a1) (s b1) <> compare (s a2) (s b2) + +instance Show Stan.Hie.Compat902.NodeAnnotation where + show + (Stan.Hie.Compat902.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2)) = + Text.Show.show (a1, a2) + +toNodeAnnotation :: GHC.Iface.Ext.Types.NodeAnnotation + -> Stan.Hie.Compat902.NodeAnnotation +toNodeAnnotation = Stan.Hie.Compat902.NodeAnnotation + +-- For forward compatibility: the two-argument function type +-- constructor. +hFunTy2 :: HieType b -> Maybe (b, b) +hFunTy2 t = case t of + HFunTy _multiplicity i1 i2 -> Just (i1, i2) + _ -> Nothing + +readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult) +readHieFileWithNameCache = do + uniqSupply <- mkSplitUniqSupply 'z' + let nameCache = initNameCache uniqSupply [] + pure (readHieFile (NCU (\f -> pure $ snd $ f nameCache))) + +newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType + deriving stock Eq + +instance Show Stan.Hie.Compat902.DeclType where + show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d)) + +conDec :: Stan.Hie.Compat902.DeclType +conDec = DeclType ConDec + +eqDeclType :: Stan.Hie.Compat902.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool +eqDeclType (DeclType d1) d2 = d1 == d2 +#else + () where +#endif diff --git a/src/Stan/Hie/Compat904.hs b/src/Stan/Hie/Compat904.hs new file mode 100644 index 00000000..2b55211e --- /dev/null +++ b/src/Stan/Hie/Compat904.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE CPP #-} + +module Stan.Hie.Compat904 +#if __GLASGOW_HASKELL__ == 904 + ( -- * Main HIE types + ContextInfo (..) + , HieArgs (..) + , HieAST (..) + , HieASTs (..) + , HieFile (..) + , HieType (..) + , HieTypeFlat + , IEType (..) + , Identifier + , IdentifierDetails (..) + , NodeInfo (..) + , TypeIndex + , Stan.Hie.Compat904.DeclType (..) + , hFunTy2 + , conDec + , eqDeclType + , Stan.Hie.Compat904.NodeAnnotation + , mkNodeAnnotation + , toNodeAnnotation + + -- * Binary interface to hie files + , HieFileResult (hie_file_result) + , readHieFileWithNameCache + , nodeInfo + ) where + +import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile) +import GHC.Iface.Ext.Types + (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), + HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, + IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + getSourcedNodeInfo, NodeAnnotation(..)) +import GHC.Types.Name.Cache (initNameCache) +import GHC.Data.FastString (FastString) +import GHC.Utils.Outputable (ppr, showSDocUnsafe) + +import qualified Data.Map.Strict as Map + +import Text.Show (show) + +-- It's not clear if this is completely correct, or whether +-- +-- 1. we should merge in the GeneratedInfo, and/or +-- 2. return a NodeInfo with empty fields when the SourceInfo is empty +-- +-- It works though. +nodeInfo :: HieAST a -> NodeInfo a +nodeInfo h = case (lookup' SourceInfo, lookup' GeneratedInfo) of + (Nothing, Nothing) -> error "nodeInfo" + (Just n1, Nothing) -> n1 + (Nothing, Just{}) -> error "nodeInfo" + (Just n1, Just{}) -> n1 + where lookup' k = Map.lookup k (getSourcedNodeInfo (sourcedNodeInfo h)) + +mkNodeAnnotation :: FastString + -> FastString + -> Stan.Hie.Compat904.NodeAnnotation +mkNodeAnnotation f1 f2 = + Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation f1 f2) + +data NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation + deriving stock (Eq, Ord) + +instance Show Stan.Hie.Compat904.NodeAnnotation where + show + (Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation a1 a2)) = + Text.Show.show (a1, a2) + +toNodeAnnotation :: GHC.Iface.Ext.Types.NodeAnnotation + -> Stan.Hie.Compat904.NodeAnnotation +toNodeAnnotation = Stan.Hie.Compat904.NodeAnnotation + +-- For forward compatibility: the two-argument function type +-- constructor. +hFunTy2 :: HieType b -> Maybe (b, b) +hFunTy2 t = case t of + HFunTy _multiplicity i1 i2 -> Just (i1, i2) + _ -> Nothing + +readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult) +readHieFileWithNameCache = do + nameCache <- initNameCache 'z' [] + pure (readHieFile nameCache) + +newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType + deriving stock Eq + +instance Show Stan.Hie.Compat904.DeclType where + show (DeclType d) = Text.Show.show (showSDocUnsafe (ppr d)) + +conDec :: Stan.Hie.Compat904.DeclType +conDec = DeclType ConDec + +eqDeclType :: Stan.Hie.Compat904.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool +eqDeclType (DeclType d1) d2 = d1 == d2 +#else + () where +#endif diff --git a/src/Stan/Hie/Debug.hs b/src/Stan/Hie/Debug.hs index b24922b9..608b9b47 100644 --- a/src/Stan/Hie/Debug.hs +++ b/src/Stan/Hie/Debug.hs @@ -1,80 +1,13 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE StandaloneDeriving #-} - -{- | -Copyright: (c) 2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik - -Useful debugging and printing utilities for HIE types. They are -implemented in two ways: - -1. Using derived 'Show' instances. -2. Using @ghc@ pretty-printing. - -To make full use of derived 'Show' instances, add the @pretty-simple@ -package to dependencies and use the @pPrint@ function from the -@Text.Pretty.Simple@ module. --} - -module Stan.Hie.Debug - ( debugHieFile - ) where - -import Text.Pretty.Simple (pPrint) - -import Stan.Core.ModuleName (fromGhcModule) -import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..), - IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module, - ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName, - moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName, - nameStableString, occNameString) -import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), - IdentifierDetails (..), NodeInfo (..)) -import Stan.NameMeta (NameMeta (..)) - -import qualified Text.Show - - -debugHieFile :: FilePath -> [HieFile] -> IO () -debugHieFile path hieFiles = do - let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles - whenJust mHieFile pPrint - --- orphan intances -deriving stock instance Show HieFile -deriving stock instance Show a => Show (HieType a) -deriving stock instance Show a => Show (HieAST a) -deriving newtype instance Show a => Show (HieASTs a) -deriving newtype instance Show a => Show (HieArgs a) -deriving stock instance Show a => Show (NodeInfo a) -deriving stock instance Show a => Show (IdentifierDetails a) -deriving stock instance Show IfaceTyCon -deriving stock instance Show IfaceTyConInfo -deriving stock instance Show IfaceTyConSort -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 a => Show (FieldLbl a) - -instance Show Module where - show = moduleStableString - -instance Show ModuleName where - show = moduleNameString - -instance Show Name where - show nm = - if isExternalName nm - then show $ toNameMeta nm - else nameStableString nm - where - toNameMeta :: Name -> NameMeta - toNameMeta name = - let nameMetaName = toText $ occNameString $ nameOccName name - nameMetaModuleName = fromGhcModule $ nameModule name - nameMetaPackage = show @Text $ moduleUnitId $ nameModule name - in NameMeta{..} +{-# LANGUAGE CPP #-} + +module Stan.Hie.Debug (module Compat) where + +#if __GLASGOW_HASKELL__ <= 810 +import Stan.Hie.Debug810 as Compat +#elif __GLASGOW_HASKELL__ == 900 +import Stan.Hie.Debug900 as Compat +#elif __GLASGOW_HASKELL__ == 902 +import Stan.Hie.Debug902 as Compat +#elif __GLASGOW_HASKELL__ == 904 +import Stan.Hie.Debug902 as Compat +#endif diff --git a/src/Stan/Hie/Debug810.hs b/src/Stan/Hie/Debug810.hs new file mode 100644 index 00000000..601da400 --- /dev/null +++ b/src/Stan/Hie/Debug810.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Useful debugging and printing utilities for HIE types. They are +implemented in two ways: + +1. Using derived 'Show' instances. +2. Using @ghc@ pretty-printing. + +To make full use of derived 'Show' instances, add the @pretty-simple@ +package to dependencies and use the @pPrint@ function from the +@Text.Pretty.Simple@ module. +-} + +module Stan.Hie.Debug810 +#if __GLASGOW_HASKELL__ <= 810 + ( debugHieFile + ) where + +import Text.Pretty.Simple (pPrint) + +import Stan.Core.ModuleName (fromGhcModule) +import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..), + IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module, + ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName, + moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName, + nameStableString, occNameString, showTUnitId) +import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), + IdentifierDetails (..), NodeInfo (..)) +import Stan.NameMeta (NameMeta (..)) + +import qualified Text.Show + + +debugHieFile :: FilePath -> [HieFile] -> IO () +debugHieFile path hieFiles = do + let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles + whenJust mHieFile pPrint + +-- orphan intances +deriving stock instance Show HieFile +deriving stock instance Show a => Show (HieType a) +deriving stock instance Show a => Show (HieAST a) +deriving newtype instance Show a => Show (HieASTs a) +deriving newtype instance Show a => Show (HieArgs a) +deriving stock instance Show a => Show (NodeInfo a) +deriving stock instance Show a => Show (IdentifierDetails a) +deriving stock instance Show IfaceTyCon +deriving stock instance Show IfaceTyConInfo +deriving stock instance Show IfaceTyConSort +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 a => Show (FieldLbl a) + +instance Show Module where + show = moduleStableString + +instance Show ModuleName where + show = moduleNameString + +instance Show Name where + show nm = + if isExternalName nm + then show $ toNameMeta nm + else nameStableString nm + where + toNameMeta :: Name -> NameMeta + toNameMeta name = + let nameMetaName = toText $ occNameString $ nameOccName name + nameMetaModuleName = fromGhcModule $ nameModule name + nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name + in NameMeta{..} +#else + () where +#endif diff --git a/src/Stan/Hie/Debug900.hs b/src/Stan/Hie/Debug900.hs new file mode 100644 index 00000000..ea73e467 --- /dev/null +++ b/src/Stan/Hie/Debug900.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE FlexibleInstances #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Useful debugging and printing utilities for HIE types. They are +implemented in two ways: + +1. Using derived 'Show' instances. +2. Using @ghc@ pretty-printing. + +To make full use of derived 'Show' instances, add the @pretty-simple@ +package to dependencies and use the @pPrint@ function from the +@Text.Pretty.Simple@ module. +-} + +module Stan.Hie.Debug900 +#if __GLASGOW_HASKELL__ == 900 + ( debugHieFile + ) where + +import Text.Pretty.Simple (pPrint) + +import Stan.Core.ModuleName (fromGhcModule) +import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..), + IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module, + ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName, + moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName, + nameStableString, occNameString, showTUnitId) +import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), + IdentifierDetails (..), NodeInfo (..)) +import Stan.NameMeta (NameMeta (..)) + +import qualified Text.Show + +import GHC.Iface.Ext.Types (SourcedNodeInfo(..), NodeOrigin(..), ContextInfo(..), IEType(..), BindType(..), Scope(..), DeclType(..), TyVarScope(..), RecFieldContext(..), EvVarSource(..), EvBindDeps(..), DeclType(..)) +import GHC.Types.Var (Specificity(..)) + +debugHieFile :: FilePath -> [HieFile] -> IO () +debugHieFile path hieFiles = do + let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles + whenJust mHieFile pPrint + +deriving stock instance Show a => Show (SourcedNodeInfo a) +deriving stock instance Show NodeOrigin +deriving stock instance Show ContextInfo +deriving stock instance Show IEType +deriving stock instance Show BindType +deriving stock instance Show Scope +deriving stock instance Show DeclType +deriving stock instance Show TyVarScope +deriving stock instance Show EvBindDeps +deriving stock instance Show EvVarSource +deriving stock instance Show RecFieldContext + +deriving stock instance Show Specificity + +-- orphan intances +deriving stock instance Show HieFile +deriving stock instance Show a => Show (HieType a) +deriving stock instance Show a => Show (HieAST a) +deriving newtype instance Show a => Show (HieASTs a) +deriving newtype instance Show a => Show (HieArgs a) +deriving stock instance Show a => Show (NodeInfo a) +deriving stock instance Show a => Show (IdentifierDetails a) +deriving stock instance Show IfaceTyCon +deriving stock instance Show IfaceTyConInfo +deriving stock instance Show IfaceTyConSort +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 a => Show (FieldLbl a) + +instance Show Module where + show = moduleStableString + +instance Show ModuleName where + show = moduleNameString + +instance Show Name where + show nm = + if isExternalName nm + then show $ toNameMeta nm + else nameStableString nm + where + toNameMeta :: Name -> NameMeta + toNameMeta name = + let nameMetaName = toText $ occNameString $ nameOccName name + nameMetaModuleName = fromGhcModule $ nameModule name + nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name + in NameMeta{..} +#else + () where +#endif diff --git a/src/Stan/Hie/Debug902.hs b/src/Stan/Hie/Debug902.hs new file mode 100644 index 00000000..dfe4674c --- /dev/null +++ b/src/Stan/Hie/Debug902.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE FlexibleInstances #-} + +{- | +Copyright: (c) 2020 Kowainik +SPDX-License-Identifier: MPL-2.0 +Maintainer: Kowainik + +Useful debugging and printing utilities for HIE types. They are +implemented in two ways: + +1. Using derived 'Show' instances. +2. Using @ghc@ pretty-printing. + +To make full use of derived 'Show' instances, add the @pretty-simple@ +package to dependencies and use the @pPrint@ function from the +@Text.Pretty.Simple@ module. +-} + +module Stan.Hie.Debug902 +#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 + ( debugHieFile + ) where + +import Text.Pretty.Simple (pPrint) + +import Stan.Core.ModuleName (fromGhcModule) +import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLabel (..), IfaceTyCon (..), + IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module, + Name, PromotionFlag (..), TupleSort (..), isExternalName, + moduleStableString, moduleUnitId, nameModule, nameOccName, + nameStableString, occNameString, showTUnitId) +import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), + IdentifierDetails (..), NodeInfo (..)) +import Stan.NameMeta (NameMeta (..)) + +import qualified Text.Show + +import GHC.Iface.Ext.Types (SourcedNodeInfo(..), NodeOrigin(..), ContextInfo(..), IEType(..), BindType(..), Scope(..), DeclType(..), TyVarScope(..), RecFieldContext(..), EvVarSource(..), EvBindDeps(..), DeclType(..), NodeAnnotation (..)) +import GHC.Types.Avail (GreName (..)) +import GHC.Types.Var (Specificity(..)) + +debugHieFile :: FilePath -> [HieFile] -> IO () +debugHieFile path hieFiles = do + let mHieFile = find (\HieFile{..} -> hie_hs_file == path) hieFiles + whenJust mHieFile pPrint + +deriving stock instance Show a => Show (SourcedNodeInfo a) +deriving stock instance Show NodeOrigin +deriving stock instance Show ContextInfo +deriving stock instance Show IEType +deriving stock instance Show BindType +deriving stock instance Show Scope +deriving stock instance Show DeclType +deriving stock instance Show TyVarScope +deriving stock instance Show EvBindDeps +deriving stock instance Show EvVarSource +deriving stock instance Show RecFieldContext + +deriving stock instance Show Specificity + +-- orphan intances +deriving stock instance Show HieFile +deriving stock instance Show a => Show (HieType a) +deriving stock instance Show a => Show (HieAST a) +deriving newtype instance Show a => Show (HieASTs a) +deriving newtype instance Show a => Show (HieArgs a) +deriving stock instance Show a => Show (NodeInfo a) +deriving stock instance Show a => Show (IdentifierDetails a) +deriving stock instance Show IfaceTyCon +deriving stock instance Show IfaceTyConInfo +deriving stock instance Show IfaceTyConSort +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 +deriving stock instance Show GreName + +instance Show Module where + show = moduleStableString + +instance Show Name where + show nm = + if isExternalName nm + then show $ toNameMeta nm + else nameStableString nm + where + toNameMeta :: Name -> NameMeta + toNameMeta name = + let nameMetaName = toText $ occNameString $ nameOccName name + nameMetaModuleName = fromGhcModule $ nameModule name + nameMetaPackage = showTUnitId $ moduleUnitId $ nameModule name + in NameMeta{..} +#else + () where +#endif diff --git a/src/Stan/Hie/MatchAst.hs b/src/Stan/Hie/MatchAst.hs index c4c2a2c2..77cba86b 100644 --- a/src/Stan/Hie/MatchAst.hs +++ b/src/Stan/Hie/MatchAst.hs @@ -19,10 +19,11 @@ module Stan.Hie.MatchAst import Data.Char (toLower) import Stan.Core.List (checkWith) -import Stan.Ghc.Compat (FastString, nameOccName, occNameString) +import Stan.Ghc.Compat (nameOccName, occNameString) import Stan.Hie (slice) import Stan.Hie.Compat (ContextInfo (..), DeclType, HieAST (..), HieFile (..), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex) + IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo, + eqDeclType, NodeAnnotation, toNodeAnnotation) import Stan.Hie.MatchType (hieMatchPatternType) import Stan.NameMeta (NameMeta, hieMatchNameMeta) import Stan.Pattern.Ast (Literal (..), PatternAst (..), literalAnns) @@ -53,7 +54,7 @@ hieMatchPatternAst hie@HieFile{..} node@Node{..} = \case hieMatchPatternAst hie node p1 && hieMatchPatternAst hie node p2 PatternAstConstant lit -> - Set.member literalAnns (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 @@ -79,8 +80,11 @@ hieMatchPatternAst hie@HieFile{..} node@Node{..} = \case PatternAstIdentifierDetailsDecl declType -> any (any (isDecl declType) . identInfo) $ Map.elems $ nodeIdentifiers nodeInfo where - matchAnnotations :: Set (FastString, FastString) -> NodeInfo TypeIndex -> Bool - matchAnnotations tags NodeInfo{..} = tags `Set.isSubsetOf` nodeAnnotations + matchAnnotations :: Set NodeAnnotation -> NodeInfo TypeIndex -> Bool + matchAnnotations tags NodeInfo{..} = + tags `Set.isSubsetOf` Set.map toNodeAnnotation nodeAnnotations + + nodeInfo = Stan.Hie.Compat.nodeInfo node matchNameAndType :: NameMeta @@ -94,5 +98,5 @@ hieMatchPatternAst hie@HieFile{..} node@Node{..} = \case t : _ -> hieMatchPatternType hie_types patType t isDecl :: DeclType -> ContextInfo -> Bool - isDecl myDeclType (Decl curDeclType _) = myDeclType == curDeclType + isDecl myDeclType (Decl curDeclType _) = myDeclType `eqDeclType` curDeclType isDecl _declType _otherContext = False diff --git a/src/Stan/Hie/MatchType.hs b/src/Stan/Hie/MatchType.hs index 582d33e8..cd385e55 100644 --- a/src/Stan/Hie/MatchType.hs +++ b/src/Stan/Hie/MatchType.hs @@ -34,7 +34,7 @@ import Data.Array (Array) import Stan.Core.List (checkWith) import Stan.Ghc.Compat (IfaceTyCon (..), IfaceTyConInfo (..), PromotionFlag (NotPromoted)) -import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex) +import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex, hFunTy2) import Stan.NameMeta (compareNames) import Stan.Pattern.Type (PatternType (..)) @@ -75,7 +75,8 @@ hieMatchPatternType arr pat i = curFlat `satisfyPattern` pat ifaceTyConIsPromoted ifaceTyConInfo == NotPromoted && compareNames nameMeta ifaceTyConName && checkWith (\(_, ix) a -> match a ix) hieArgs args - satisfyPattern (HFunTy i1 i2) (PatternTypeFun p1 p2) = + satisfyPattern t (PatternTypeFun p1 p2) + | Just (i1, i2) <- hFunTy2 t = match p1 i1 && match p2 i2 satisfyPattern (HQualTy _ ix) p = match p ix diff --git a/src/Stan/Inspection/Partial.hs b/src/Stan/Inspection/Partial.hs index 48ea604d..c5490b33 100644 --- a/src/Stan/Inspection/Partial.hs +++ b/src/Stan/Inspection/Partial.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- | Copyright: (c) 2020 Kowainik SPDX-License-Identifier: MPL-2.0 @@ -277,7 +279,11 @@ stan0020 = mkPartialInspectionPattern (Id "STAN-0020") exts pat "" & analysisL .~ FindAst (namesToPatternAst $ (exts, pat) :| [(ne, pat)]) where pat = listPattern |-> nonEmptyPattern +#if __GLASGOW_HASKELL__ < 904 exts = "fromList" `baseNameFrom` "GHC.Exts" +#else + exts = "fromList" `baseNameFrom` "GHC.IsList" +#endif ne = "fromList" `baseNameFrom` "Data.List.NonEmpty" -- | 'Inspection' — partial 'GHC.Num.fromInteger' @STAN-0021@. diff --git a/src/Stan/NameMeta.hs b/src/Stan/NameMeta.hs index ffa34933..34ff63c6 100644 --- a/src/Stan/NameMeta.hs +++ b/src/Stan/NameMeta.hs @@ -31,9 +31,9 @@ module Stan.NameMeta ) where import Stan.Core.ModuleName (ModuleName (..), fromGhcModule) -import Stan.Ghc.Compat (Name, isExternalName, moduleUnitId, nameModule, nameOccName, occNameString) +import Stan.Ghc.Compat (Name, isExternalName, moduleUnitId, nameModule, nameOccName, occNameString, showTUnitId) import Stan.Hie.Compat (ContextInfo (IEThing), HieAST (..), IEType (Import), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex) + IdentifierDetails (..), NodeInfo (..), TypeIndex, nodeInfo) import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -60,7 +60,7 @@ compareNames :: NameMeta -> Name -> Bool compareNames NameMeta{..} name = let occName = toText $ occNameString $ nameOccName name moduleName = fromGhcModule $ nameModule name - package = show @Text $ moduleUnitId $ nameModule name + package = showTUnitId $ moduleUnitId $ nameModule name in isExternalName name && occName == nameMetaName diff --git a/src/Stan/Pattern/Ast.hs b/src/Stan/Pattern/Ast.hs index 320d6bad..37bd5c19 100644 --- a/src/Stan/Pattern/Ast.hs +++ b/src/Stan/Pattern/Ast.hs @@ -45,8 +45,7 @@ module Stan.Pattern.Ast , literalAnns ) where -import Stan.Ghc.Compat (FastString) -import Stan.Hie.Compat (DeclType (..)) +import Stan.Hie.Compat (DeclType, NodeAnnotation, mkNodeAnnotation, conDec) import Stan.NameMeta (NameMeta (..)) import Stan.Pattern.Edsl (PatternBool (..)) import Stan.Pattern.Type (PatternType) @@ -67,11 +66,11 @@ data PatternAst | PatternAstVarName !String -- | AST node with tags for current node and any children. | PatternAstNode - !(Set (FastString, FastString)) -- ^ Set of context info (pairs of tags) + !(Set NodeAnnotation) -- ^ Set of context info (pairs of tags) -- | AST node with tags for current node and children -- patterns. This pattern should match the node exactly. | PatternAstNodeExact - !(Set (FastString, FastString)) -- ^ Set of context info (pairs of tags) + !(Set NodeAnnotation) -- ^ Set of context info (pairs of tags) ![PatternAst] -- ^ Node children -- | AST wildcard, matches anything. | PatternAstAnything @@ -124,46 +123,46 @@ anyNamesToPatternAst = namesToPatternAst . fmap (, (?)) -- | @app f x@ is a pattern for function application @f x@. app :: PatternAst -> PatternAst -> PatternAst -app f x = PatternAstNodeExact (one ("HsApp", "HsExpr")) [f, x] +app f x = PatternAstNodeExact (one (mkNodeAnnotation "HsApp" "HsExpr")) [f, x] -- | @opApp x op y@ is a pattern for operator application @x `op` y@. opApp :: PatternAst -> PatternAst -> PatternAst -> PatternAst -opApp x op y = PatternAstNodeExact (one ("OpApp", "HsExpr")) [x, op, y] +opApp x op y = PatternAstNodeExact (one (mkNodeAnnotation "OpApp" "HsExpr")) [x, op, y] -- | @range a b@ is a pattern for @[a .. b]@ range :: PatternAst -> PatternAst -> PatternAst -range from to = PatternAstNodeExact (one ("ArithSeq", "HsExpr")) [from, to] +range from to = PatternAstNodeExact (one (mkNodeAnnotation "ArithSeq" "HsExpr")) [from, to] -- | 'lambdaCase' is a pattern for @\case@ expression (not considering branches). lambdaCase :: PatternAst -lambdaCase = PatternAstNode (one ("HsLamCase", "HsExpr")) +lambdaCase = PatternAstNode (one (mkNodeAnnotation "HsLamCase" "HsExpr")) -- | 'case'' is a pattern for @case EXP of@ expression (not considering branches). case' :: PatternAst -case' = PatternAstNode (one ("HsCase", "HsExpr")) +case' = PatternAstNode (one (mkNodeAnnotation "HsCase" "HsExpr")) -- | Pattern to represent one pattern matching branch. patternMatchBranch :: PatternAst -patternMatchBranch = PatternAstNode (one ("Match", "Match")) +patternMatchBranch = PatternAstNode (one (mkNodeAnnotation "Match" "Match")) {- | Pattern for @_@ in pattern matching. __Note:__ presents on GHC >=8.10 only. -} wildPat :: PatternAst -wildPat = PatternAstNode (one ("WildPat", "Pat")) +wildPat = PatternAstNode (one (mkNodeAnnotation "WildPat" "Pat")) {- | Pattern for literals in pattern matching. __Note:__ presents on GHC >=8.10 only. -} literalPat :: PatternAst -literalPat = PatternAstNode (one ("NPat", "Pat")) - ||| PatternAstNode (one ("LitPat", "Pat")) +literalPat = PatternAstNode (one (mkNodeAnnotation "NPat" "Pat")) + ||| PatternAstNode (one (mkNodeAnnotation "LitPat" "Pat")) -- | Pattern to represent one pattern matching branch on @_@. patternMatch_ :: PatternAst -> PatternAst -patternMatch_ val = PatternAstNodeExact (one ("Match", "Match")) +patternMatch_ val = PatternAstNodeExact (one (mkNodeAnnotation "Match" "Match")) #if __GLASGOW_HASKELL__ >= 810 $ wildPat : #endif @@ -171,7 +170,7 @@ patternMatch_ val = PatternAstNodeExact (one ("Match", "Match")) -- | Pattern to represent right side of the pattern matching, e.g. @-> "foo"@. patternMatchArrow :: PatternAst -> PatternAst -patternMatchArrow x = PatternAstNodeExact (one ("GRHS", "GRHS")) [x] +patternMatchArrow x = PatternAstNodeExact (one (mkNodeAnnotation "GRHS" "GRHS")) [x] {- | Pattern for the top-level fixity declaration: @@ -180,7 +179,7 @@ infixr 7 ***, +++, ??? @ -} fixity :: PatternAst -fixity = PatternAstNode $ one ("FixitySig", "FixitySig") +fixity = PatternAstNode $ one (mkNodeAnnotation "FixitySig" "FixitySig") {- | Pattern for the function type signature declaration: @@ -189,7 +188,14 @@ foo :: Some -> Type @ -} typeSig :: PatternAst -typeSig = PatternAstNode $ one ("TypeSig", "Sig") +typeSig = PatternAstNode $ one (mkNodeAnnotation "TypeSig" "Sig") + +absBinds = +#if __GLASGOW_HASKELL__ < 904 + mkNodeAnnotation "AbsBinds" "HsBindLR" +#else + mkNodeAnnotation "XHsBindsLR" "HsBindLR" +#endif {- | Pattern for the function definition: @@ -199,26 +205,26 @@ foo x y = ... -} fun :: PatternAst fun = PatternAstNode $ Set.fromList - [ ("AbsBinds", "HsBindLR") - , ("FunBind", "HsBindLR") - , ("Match", "Match") + [ absBinds + , mkNodeAnnotation "FunBind" "HsBindLR" + , mkNodeAnnotation "Match" "Match" ] {- | @data@ or @newtype@ declaration. -} dataDecl :: PatternAst -dataDecl = PatternAstNode $ one ("DataDecl", "TyClDecl") +dataDecl = PatternAstNode $ one (mkNodeAnnotation "DataDecl" "TyClDecl") {- | Constructor of a plain data type or newtype. Children of node that matches this pattern are constructor fields. -} constructor :: PatternAst -constructor = PatternAstNode $ one ("ConDeclH98", "ConDecl") +constructor = PatternAstNode $ one (mkNodeAnnotation "ConDeclH98" "ConDecl") {- | Constructor name Identifier info -} constructorNameIdentifier :: PatternAst -constructorNameIdentifier = PatternAstIdentifierDetailsDecl ConDec +constructorNameIdentifier = PatternAstIdentifierDetailsDecl conDec {- | Lazy data type field. Comes in two shapes: @@ -240,17 +246,17 @@ cases: -} type_ :: PatternAst type_ = - PatternAstNode (one ("HsTyVar", "HsType")) -- simple type: Int, Bool + PatternAstNode (one (mkNodeAnnotation "HsTyVar" "HsType")) -- simple type: Int, Bool ||| - PatternAstNode (one ("HsAppTy", "HsType")) -- composite: Maybe Int + PatternAstNode (one (mkNodeAnnotation "HsAppTy" "HsType")) -- composite: Maybe Int ||| - PatternAstNode (one ("HsParTy", "HsType")) -- type in () + PatternAstNode (one (mkNodeAnnotation "HsParTy" "HsType")) -- type in () ||| - PatternAstNode (one ("HsTupleTy", "HsType")) -- tuple types: (Int, Bool) + PatternAstNode (one (mkNodeAnnotation "HsTupleTy" "HsType")) -- tuple types: (Int, Bool) ||| - PatternAstNode (one ("HsListTy", "HsType")) -- list types: [Int] + PatternAstNode (one (mkNodeAnnotation "HsListTy" "HsType")) -- list types: [Int] ||| - PatternAstNode (one ("HsFunTy", "HsType")) -- function types: Int -> Bool + PatternAstNode (one (mkNodeAnnotation "HsFunTy" "HsType")) -- function types: Int -> Bool {- | Pattern for the field without the explicit bang pattern: @@ -260,11 +266,11 @@ someField :: Int -} lazyRecordField :: PatternAst lazyRecordField = PatternAstNodeExact - (one ("ConDeclField", "ConDeclField")) + (one (mkNodeAnnotation "ConDeclField" "ConDeclField")) [ PatternAstNode (fromList - [ ("AbsBinds", "HsBindLR") - , ("FunBind", "HsBindLR") + [ absBinds + , mkNodeAnnotation "FunBind" "HsBindLR" ] ) , type_ @@ -277,9 +283,9 @@ lazyRecordField = PatternAstNodeExact -} tuple :: PatternAst tuple = - PatternAstNode (one ("HsTupleTy", "HsType")) -- tuple type + PatternAstNode (one (mkNodeAnnotation "HsTupleTy" "HsType")) -- tuple type ||| - PatternAstNode (one ("ExplicitTuple", "HsExpr")) -- tuple literal + PatternAstNode (one (mkNodeAnnotation "ExplicitTuple" "HsExpr")) -- tuple literal {- | Pattern for a single @guard@ branch: @@ -288,7 +294,7 @@ tuple = @ -} guardBranch :: PatternAst -guardBranch = PatternAstNode $ one ("BodyStmt", "StmtLR") +guardBranch = PatternAstNode $ one (mkNodeAnnotation "BodyStmt" "StmtLR") {- | Pattern for the right-hand-side. Usually an equality sign. @@ -297,8 +303,8 @@ guardBranch = PatternAstNode $ one ("BodyStmt", "StmtLR") @ -} rhs :: PatternAst -rhs = PatternAstNode $ one ("GRHS", "GRHS") +rhs = PatternAstNode $ one (mkNodeAnnotation "GRHS" "GRHS") -- | Annotations for constants: 0, "foo", etc. -literalAnns :: (FastString, FastString) -literalAnns = ("HsOverLit", "HsExpr") +literalAnns :: NodeAnnotation +literalAnns = mkNodeAnnotation "HsOverLit" "HsExpr" diff --git a/src/Stan/Pattern/Type.hs b/src/Stan/Pattern/Type.hs index 8815f8eb..db06b43e 100644 --- a/src/Stan/Pattern/Type.hs +++ b/src/Stan/Pattern/Type.hs @@ -1,3 +1,5 @@ +{-# LANGuAGE CPP #-} + {- HLINT ignore "Avoid lambda using `infix`" -} {- | @@ -105,16 +107,44 @@ listFunPattern :: PatternType listFunPattern = listPattern |-> (?) -- | 'PatternType' for 'Integer'. -integerPattern :: PatternType -integerPattern = NameMeta +integerPattern = +#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 { nameMetaName = "Integer" , nameMetaModuleName = "GHC.Integer.Type" , nameMetaPackage = "integer-wired-in" } |:: [] --- | 'PatternType' for 'Natural'. -naturalPattern :: PatternType -naturalPattern = "Natural" `baseNameFrom` "GHC.Natural" |:: [] +integerPattern900 :: PatternType +integerPattern900 = NameMeta + { nameMetaName = "Integer" + , nameMetaModuleName = "GHC.Num.Integer" + , nameMetaPackage = "ghc-bignum" + } |:: [] + +naturalPattern810 :: PatternType +naturalPattern810 = "Natural" `baseNameFrom` "GHC.Natural" |:: [] + +naturalPattern900 :: PatternType +naturalPattern900 = NameMeta + { nameMetaName = "Natural" + , nameMetaModuleName = "GHC.Num.Natural" + , nameMetaPackage = "ghc-bignum" + } |:: [] charPattern :: PatternType charPattern = primTypeMeta "Char" |:: [] diff --git a/src/Stan/Report/Css.hs b/src/Stan/Report/Css.hs index e0ccd6e0..1de5e40e 100644 --- a/src/Stan/Report/Css.hs +++ b/src/Stan/Report/Css.hs @@ -1,3 +1,5 @@ +{- HLINT ignore "Use zipWithM_" -} + {-# LANGUAGE PostfixOperators #-} {- | @@ -13,12 +15,21 @@ module Stan.Report.Css import Prelude hiding (div, rem, (&), (**)) -import Clay hiding (brown, cols, grid) +import Clay hiding (brown, cols, grid, border, borderRight, borderTop, borderLeft, borderBottom) +import qualified Clay import qualified Clay.Media as M import qualified Data.List.NonEmpty as NE +border, borderLeft, borderBottom, borderRight, borderTop + :: Stroke -> Size LengthUnit -> Color -> Css +border x y = Clay.border y x +borderLeft x y = Clay.borderLeft y x +borderBottom x y = Clay.borderBottom y x +borderRight x y = Clay.borderRight y x +borderTop x y = Clay.borderTop y x + stanCss :: Css stanCss = do grid diff --git a/stack.yaml b/stack.yaml index f77cfed1..7cb7a732 100644 --- a/stack.yaml +++ b/stack.yaml @@ -13,3 +13,4 @@ extra-deps: - trial-0.0.0.0 - trial-optparse-applicative-0.0.0.0 - trial-tomland-0.0.0.0 +- clay-0.14.0 diff --git a/stan.cabal b/stan.cabal index f049259a..5c0d948b 100644 --- a/stan.cabal +++ b/stan.cabal @@ -26,7 +26,10 @@ source-repository head location: https://github.com/kowainik/stan.git common common-options - build-depends: base >= 4.13 && < 4.15 + build-depends: base >= 4.13 && < 4.19 && (< 4.16.3.0 || >= 4.17) + -- ^^ .hie files don't contain enough type + -- information on ghc-9.2.[4-8] (base >= + -- 4.16.3.0 && < 4.17) ghc-options: -Wall -Wcompat @@ -61,7 +64,7 @@ common common-options ViewPatterns common common-relude - build-depends: relude ^>= 1.0 + build-depends: relude >= 1.0 && < 1.3 mixins: base hiding (Prelude) , relude (Relude as Prelude) , relude @@ -87,11 +90,21 @@ library Stan.Core.ModuleName Stan.Example Stan.Ghc.Compat + Stan.Ghc.Compat810 + Stan.Ghc.Compat900 + Stan.Ghc.Compat902 Stan.EnvVars Stan.FileInfo Stan.Hie Stan.Hie.Compat + Stan.Hie.Compat810 + Stan.Hie.Compat900 + Stan.Hie.Compat902 + Stan.Hie.Compat904 Stan.Hie.Debug + Stan.Hie.Debug810 + Stan.Hie.Debug900 + Stan.Hie.Debug902 Stan.Hie.MatchAst Stan.Hie.MatchType Stan.Info @@ -119,22 +132,22 @@ library build-depends: array ^>= 0.5 , base64 ^>= 0.4.1 , blaze-html ^>= 0.9.1 - , bytestring ^>= 0.10 - , clay ^>= 0.13 + , bytestring >= 0.10 && < 0.12 + , clay ^>= 0.14 , colourista >= 0.1 && < 0.3 , cryptohash-sha1 ^>= 0.11 , dir-traverse ^>= 0.2.2.2 , directory ^>= 1.3 - , extensions ^>= 0.0.0.1 + , extensions ^>= 0.0.0.1 || ^>= 0.1.0.0 , filepath ^>= 1.4 - , ghc >= 8.8 && < 8.11 - , ghc-boot-th >= 8.8 && < 8.11 + , ghc >= 8.8 && < 9.5 + , ghc-boot-th >= 8.8 && < 9.5 , gitrev ^>= 1.3.1 , microaeson ^>= 0.1.0.0 , optparse-applicative >= 0.15 && < 0.17 , pretty-simple ^>= 4.0 , process ^>= 1.6.8.0 - , slist ^>= 0.1 + , slist >= 0.1 && < 0.3 , tomland ^>= 1.3.0.0 , trial ^>= 0.0.0.0 , trial-optparse-applicative ^>= 0.0.0.0 @@ -186,9 +199,9 @@ test-suite stan-test , containers , filepath ^>= 1.4 , ghc - , hedgehog ^>= 1.0 - , hspec ^>= 2.7 - , hspec-hedgehog ^>= 0.0.1.2 + , hedgehog >= 1.0 && < 1.2 + , hspec >= 2.7 && < 2.11 + , hspec-hedgehog >= 0.0.1.2 , optparse-applicative , text , tomland diff --git a/test/Spec.hs b/test/Spec.hs index 57701883..4b729c77 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,6 @@ module Main (main) where -import HieTypes (HieFile (..)) +import Stan.Hie.Compat (HieFile (..)) import System.FilePath (()) import Test.Hspec (hspec) diff --git a/test/Test/Stan/Analysis.hs b/test/Test/Stan/Analysis.hs index e707a8d7..68c01c9c 100644 --- a/test/Test/Stan/Analysis.hs +++ b/test/Test/Stan/Analysis.hs @@ -2,7 +2,7 @@ module Test.Stan.Analysis ( analysisSpec ) where -import HieTypes (HieFile (..)) +import Stan.Hie.Compat (HieFile (..)) import System.FilePath (()) import Test.Hspec (Spec, describe, it, runIO, shouldBe) diff --git a/test/Test/Stan/Analysis/Common.hs b/test/Test/Stan/Analysis/Common.hs index c9e632ae..fac2ae37 100644 --- a/test/Test/Stan/Analysis/Common.hs +++ b/test/Test/Stan/Analysis/Common.hs @@ -9,8 +9,7 @@ module Test.Stan.Analysis.Common ) where import Prelude hiding (span) -import FastString (FastString, mkFastString) -import SrcLoc (RealSrcSpan, mkRealSrcLoc, mkRealSrcSpan, srcSpanStartLine) +import Stan.Ghc.Compat (FastString, mkFastString, RealSrcSpan, mkRealSrcLoc, mkRealSrcSpan, srcSpanStartLine) import System.FilePath (pathSeparator, ()) import Test.Hspec (Expectation, shouldBe) diff --git a/test/Test/Stan/Analysis/Partial.hs b/test/Test/Stan/Analysis/Partial.hs index 44003804..43c5d755 100644 --- a/test/Test/Stan/Analysis/Partial.hs +++ b/test/Test/Stan/Analysis/Partial.hs @@ -45,8 +45,6 @@ analysisPartialSpec analysis = describe "Partial functions" $ do end = start + funLen checkObservationFor :: Inspection -> Int -> Int -> Int -> Expectation - checkObservationFor ins line start end = observationAssert + checkObservationFor = observationAssert ["Partial"] analysis - ins - line start end diff --git a/test/Test/Stan/Number.hs b/test/Test/Stan/Number.hs index d02d8f2c..72637fe9 100644 --- a/test/Test/Stan/Number.hs +++ b/test/Test/Stan/Number.hs @@ -3,7 +3,7 @@ module Test.Stan.Number , modulesNumSpec ) where -import HieTypes (HieFile (..)) +import Stan.Hie.Compat (HieFile (..)) import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) import Stan.Hie (countLinesOfCode) diff --git a/test/Test/Stan/Observation.hs b/test/Test/Stan/Observation.hs index e3e062d2..7e83be84 100644 --- a/test/Test/Stan/Observation.hs +++ b/test/Test/Stan/Observation.hs @@ -2,7 +2,7 @@ module Test.Stan.Observation ( observationSpec ) where -import SrcLoc (mkRealSrcLoc, mkRealSrcSpan) +import Stan.Ghc.Compat (mkRealSrcLoc, mkRealSrcSpan) import Test.Hspec (Spec, describe, it, shouldBe) import Stan.Core.Id (Id (..))