diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,11 @@ `stan` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +## 0.1.1.0 + +* Fix [bug #541](https://github.com/kowainik/stan/issues/541) + "`nodeInfo`" + ## 0.1.0.2 * Add prospective support for GHC 9.8 diff --git a/src/Stan/Hie.hs b/src/Stan/Hie.hs --- a/src/Stan/Hie.hs +++ b/src/Stan/Hie.hs @@ -84,7 +84,7 @@ are not stored in 'HieAST' and to compare constants we need to compare parts of source code. -} -eqAst :: forall a . Eq a => HieFile -> HieAST a -> HieAST a -> Bool +eqAst :: forall a . Ord a => HieFile -> HieAST a -> HieAST a -> Bool eqAst HieFile{..} = eqNodes where eqNodes :: HieAST a -> HieAST a -> Bool diff --git a/src/Stan/Hie/Compat900.hs b/src/Stan/Hie/Compat900.hs --- a/src/Stan/Hie/Compat900.hs +++ b/src/Stan/Hie/Compat900.hs @@ -34,8 +34,9 @@ import GHC.Iface.Ext.Types (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + IdentifierDetails (..), NodeInfo (..), TypeIndex, getSourcedNodeInfo) +import GHC.Iface.Ext.Utils (emptyNodeInfo) import GHC.Types.Name.Cache (initNameCache) import GHC.Types.Unique.Supply (mkSplitUniqSupply) import GHC.Data.FastString (FastString) @@ -43,22 +44,28 @@ import GHC.Utils.Outputable (ppr, showSDocUnsafe) import qualified Data.Map.Strict as Map +import qualified Data.Set as S 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)) +-- This is a direct copy of GHC.Iface.Ext.Utils.emptyNodeInfo except +-- we're using our own redefined combineNodeInfo. +nodeInfo :: Ord a => HieAST a -> NodeInfo a +nodeInfo = foldl' combineNodeInfo emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo + +-- This is a direct copy of GHC.Iface.Ext.Utils.combineNodeInfo except +-- we use compare rather than nonDetCmpType. +combineNodeInfo :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a +(NodeInfo as ai ad) `combineNodeInfo` (NodeInfo bs bi bd) = + NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd) + where + mergeSorted :: Ord b => [b] -> [b] -> [b] + mergeSorted lc@(c:cs) ld@(d:ds) = case compare c d of + LT -> c : mergeSorted cs ld + EQ -> c : mergeSorted cs ds + GT -> d : mergeSorted lc ds + mergeSorted cs [] = cs + mergeSorted [] ds = ds type NodeAnnotation = (FastString, FastString) diff --git a/src/Stan/Hie/Compat902.hs b/src/Stan/Hie/Compat902.hs --- a/src/Stan/Hie/Compat902.hs +++ b/src/Stan/Hie/Compat902.hs @@ -33,8 +33,9 @@ import GHC.Iface.Ext.Types (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + IdentifierDetails (..), NodeInfo (..), TypeIndex, getSourcedNodeInfo, NodeAnnotation(..)) +import GHC.Iface.Ext.Utils (emptyNodeInfo) import GHC.Types.Name.Cache (initNameCache) import GHC.Types.Unique.Supply (mkSplitUniqSupply) import GHC.Data.FastString (FastString) @@ -42,22 +43,28 @@ import GHC.Utils.Outputable (ppr, showSDocUnsafe) import qualified Data.Map.Strict as Map +import qualified Data.Set as S 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)) +-- This is a direct copy of GHC.Iface.Ext.Utils.emptyNodeInfo except +-- we're using our own redefined combineNodeInfo. +nodeInfo :: Ord a => HieAST a -> NodeInfo a +nodeInfo = foldl' combineNodeInfo emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo + +-- This is a direct copy of GHC.Iface.Ext.Utils.combineNodeInfo except +-- we use compare rather than nonDetCmpType. +combineNodeInfo :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a +(NodeInfo as ai ad) `combineNodeInfo` (NodeInfo bs bi bd) = + NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd) + where + mergeSorted :: Ord b => [b] -> [b] -> [b] + mergeSorted lc@(c:cs) ld@(d:ds) = case compare c d of + LT -> c : mergeSorted cs ld + EQ -> c : mergeSorted cs ds + GT -> d : mergeSorted lc ds + mergeSorted cs [] = cs + mergeSorted [] ds = ds mkNodeAnnotation :: FastString -> FastString 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 @@ -33,30 +33,37 @@ import GHC.Iface.Ext.Types (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier, - IdentifierDetails (..), NodeInfo (..), TypeIndex, NodeOrigin(SourceInfo, GeneratedInfo), + IdentifierDetails (..), NodeInfo (..), TypeIndex, getSourcedNodeInfo, NodeAnnotation(..)) +import GHC.Iface.Ext.Utils (emptyNodeInfo) 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 qualified Data.Set as S 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)) +-- This is a direct copy of GHC.Iface.Ext.Utils.emptyNodeInfo except +-- we're using our own redefined combineNodeInfo. +nodeInfo :: Ord a => HieAST a -> NodeInfo a +nodeInfo = foldl' combineNodeInfo emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo +-- This is a direct copy of GHC.Iface.Ext.Utils.combineNodeInfo except +-- we use compare rather than nonDetCmpType. +combineNodeInfo :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a +(NodeInfo as ai ad) `combineNodeInfo` (NodeInfo bs bi bd) = + NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd) + where + mergeSorted :: Ord b => [b] -> [b] -> [b] + mergeSorted lc@(c:cs) ld@(d:ds) = case compare c d of + LT -> c : mergeSorted cs ld + EQ -> c : mergeSorted cs ds + GT -> d : mergeSorted lc ds + mergeSorted cs [] = cs + mergeSorted [] ds = ds + mkNodeAnnotation :: FastString -> FastString -> Stan.Hie.Compat904.NodeAnnotation @@ -101,3 +108,4 @@ #else () where #endif + diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,15 +1,11 @@ -resolver: lts-21.15 # GHC 9.4.7 +resolver: lts-21.22 # GHC 9.4.8 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 +- validation-selective-0.2.0.0@sha256:e1ab5482dede8bf676d729a09109c7c5f798363b9d458e4197a27afb8b48fdd3,3907 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.2 +version: 0.1.1.0 synopsis: Haskell STatic ANalyser description: Stan is a Haskell __ST__atic __AN__alysis CLI tool. @@ -138,6 +138,7 @@ , bytestring >= 0.10 && < 0.13 , clay ^>= 0.14 , colourista >= 0.1 && < 0.3 + , containers >= 0.5 && < 0.7 , cryptohash-sha1 ^>= 0.11 , dir-traverse ^>= 0.2.2.2 , directory ^>= 1.3 @@ -148,7 +149,7 @@ , gitrev ^>= 1.3.1 , microaeson ^>= 0.1.0.0 , optparse-applicative >= 0.15 && < 0.19 - , pretty-simple ^>= 4.0 + , pretty-simple >= 4.0 && < 4.2 , process ^>= 1.6.8.0 , slist >= 0.1 && < 0.3 , tomland ^>= 1.3.0.0