hls-graph 2.6.0.0 → 2.7.0.0

raw patch · 15 files changed

+254/−230 lines, 15 filesdep −tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies removed: tasty-hunit

API changes (from Hackage documentation)

Files

• hls-graph.cabal +17/−17
• src/Control/Concurrent/STM/Stats.hs +2/−3
• src/Development/IDE/Graph.hs +4/−3
• src/Development/IDE/Graph/Database.hs +1/−3
• src/Development/IDE/Graph/Internal/Action.hs +2/−3
• src/Development/IDE/Graph/Internal/Database.hs +5/−8
• src/Development/IDE/Graph/Internal/Key.hs +174/−0
• src/Development/IDE/Graph/Internal/Profile.hs +4/−3
• src/Development/IDE/Graph/Internal/Rules.hs +3/−3
• src/Development/IDE/Graph/Internal/Types.hs +21/−155
• src/Development/IDE/Graph/KeyMap.hs +1/−1
• src/Development/IDE/Graph/KeySet.hs +1/−1
• test/ActionSpec.hs +9/−13
• test/DatabaseSpec.hs +4/−9
• test/Example.hs +6/−8

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-graph-version:            2.6.0.0+version:            2.7.0.0 synopsis:           Haskell Language Server internal graph API description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server/tree/master/hls-graph#readme>@@ -39,7 +39,16 @@   type:     git   location: https://github.com/haskell/haskell-language-server +common warnings+  ghc-options:+    -Wall+    -Wredundant-constraints+    -Wunused-packages+    -Wno-name-shadowing+    -Wno-unticked-promoted-constructors+ library+  import: warnings   exposed-modules:     Control.Concurrent.STM.Stats     Development.IDE.Graph@@ -48,6 +57,7 @@     Development.IDE.Graph.Internal.Action     Development.IDE.Graph.Internal.Database     Development.IDE.Graph.Internal.Options+    Development.IDE.Graph.Internal.Key     Development.IDE.Graph.Internal.Paths     Development.IDE.Graph.Internal.Profile     Development.IDE.Graph.Internal.Rules@@ -66,7 +76,6 @@     , bytestring     , containers     , deepseq-    , directory     , exceptions     , extra     , filepath@@ -89,26 +98,24 @@     build-depends:       , file-embed        >=0.0.11       , template-haskell+  else+    build-depends:+      directory    if flag(stm-stats)     cpp-options: -DSTM_STATS -  ghc-options:-    -Wall -Wredundant-constraints -Wno-name-shadowing-    -Wno-unticked-promoted-constructors -Wunused-packages-   if flag(pedantic)     ghc-options: -Werror -  default-language:   Haskell2010+  default-language:   GHC2021   default-extensions:     DataKinds-    KindSignatures-    TypeOperators  test-suite tests+  import: warnings   type:               exitcode-stdio-1.0-  default-language:   Haskell2010+  default-language:   GHC2021   hs-source-dirs:     test   main-is:            Main.hs   other-modules:@@ -120,23 +127,16 @@    ghc-options:     -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts-    -Wunused-packages    build-depends:     , base-    , containers-    , directory     , extra-    , filepath     , hls-graph     , hspec     , stm     , stm-containers     , tasty     , tasty-hspec-    , tasty-hunit     , tasty-rerun-    , text-    , unordered-containers    build-tool-depends: hspec-discover:hspec-discover

@@ -1,7 +1,6 @@-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP             #-} #ifdef STM_STATS-{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE RecordWildCards #-} #endif module Control.Concurrent.STM.Stats     ( atomicallyNamed

@@ -3,7 +3,7 @@       shakeOptions,     Rules,     Action, action,-    Key(.., Key),+    pattern Key,     newKey, renderKey,     actionFinally, actionBracket, actionCatch, actionFork,     -- * Configuration@@ -25,9 +25,10 @@     ) where  import           Development.IDE.Graph.Database-import           Development.IDE.Graph.KeyMap-import           Development.IDE.Graph.KeySet import           Development.IDE.Graph.Internal.Action+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Options import           Development.IDE.Graph.Internal.Rules import           Development.IDE.Graph.Internal.Types+import           Development.IDE.Graph.KeyMap+import           Development.IDE.Graph.KeySet

@@ -1,6 +1,3 @@--{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE ExistentialQuantification #-} module Development.IDE.Graph.Database(     ShakeDatabase,     ShakeValue,@@ -19,6 +16,7 @@ import           Development.IDE.Graph.Classes           () import           Development.IDE.Graph.Internal.Action import           Development.IDE.Graph.Internal.Database+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Options import           Development.IDE.Graph.Internal.Profile  (writeProfile) import           Development.IDE.Graph.Internal.Rules

@@ -1,6 +1,4 @@-{-# LANGUAGE ConstraintKinds     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeFamilies #-}  module Development.IDE.Graph.Internal.Action ( ShakeValue@@ -29,6 +27,7 @@ import           Data.IORef import           Development.IDE.Graph.Classes import           Development.IDE.Graph.Internal.Database+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Rules    (RuleResult) import           Development.IDE.Graph.Internal.Types import           System.Exit

@@ -2,14 +2,10 @@ -- has the constraints we need on it when we get it out. {-# OPTIONS_GHC -Wno-redundant-constraints #-} -{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ViewPatterns       #-}  module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where @@ -37,6 +33,7 @@ import           Data.Tuple.Extra import           Debug.Trace                          (traceM) import           Development.IDE.Graph.Classes+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Rules import           Development.IDE.Graph.Internal.Types import qualified Focus

@@ -0,0 +1,174 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE PatternSynonyms    #-}+{-# LANGUAGE ViewPatterns       #-}++module Development.IDE.Graph.Internal.Key+    ( Key -- Opaque - don't expose constructor, use newKey to create+    , KeyValue (..)+    , pattern Key+    , newKey+    , renderKey+    -- * KeyMap+    , KeyMap+    , mapKeyMap+    , insertKeyMap+    , lookupKeyMap+    , lookupDefaultKeyMap+    , fromListKeyMap+    , fromListWithKeyMap+    , toListKeyMap+    , elemsKeyMap+    , restrictKeysKeyMap+    -- * KeySet+    , KeySet+    , nullKeySet+    , insertKeySet+    , memberKeySet+    , toListKeySet+    , lengthKeySet+    , filterKeySet+    , singletonKeySet+    , fromListKeySet+    , deleteKeySet+    , differenceKeySet+    ) where++--import Control.Monad.IO.Class ()+import           Data.Coerce+import           Data.Dynamic+import qualified Data.HashMap.Strict           as Map+import           Data.IntMap                   (IntMap)+import qualified Data.IntMap.Strict            as IM+import           Data.IntSet                   (IntSet)+import qualified Data.IntSet                   as IS+import           Data.IORef+import           Data.Text                     (Text)+import qualified Data.Text                     as T+import           Data.Typeable+import           Development.IDE.Graph.Classes+import           System.IO.Unsafe+++newtype Key = UnsafeMkKey Int++pattern Key :: () => (Typeable a, Hashable a, Show a) => a -> Key+pattern Key a <- (lookupKeyValue -> KeyValue a _)+{-# COMPLETE Key #-}++data KeyValue = forall a . (Typeable a, Hashable a, Show a) => KeyValue a Text++instance Eq KeyValue where+    KeyValue a _ == KeyValue b _ = Just a == cast b+instance Hashable KeyValue where+    hashWithSalt i (KeyValue x _) = hashWithSalt i (typeOf x, x)+instance Show KeyValue where+    show (KeyValue _ t) = T.unpack t++data GlobalKeyValueMap = GlobalKeyValueMap !(Map.HashMap KeyValue Key) !(IntMap KeyValue) {-# UNPACK #-} !Int++keyMap :: IORef GlobalKeyValueMap+keyMap = unsafePerformIO $ newIORef (GlobalKeyValueMap Map.empty IM.empty 0)++{-# NOINLINE keyMap #-}++newKey :: (Typeable a, Hashable a, Show a) => a -> Key+newKey k = unsafePerformIO $ do+  let !newKey = KeyValue k (T.pack (show k))+  atomicModifyIORef' keyMap $ \km@(GlobalKeyValueMap hm im n) ->+    let new_key = Map.lookup newKey hm+    in case new_key of+          Just v  -> (km, v)+          Nothing ->+            let !new_index = UnsafeMkKey n+            in (GlobalKeyValueMap (Map.insert newKey new_index hm) (IM.insert n newKey im) (n+1), new_index)+{-# NOINLINE newKey #-}++lookupKeyValue :: Key -> KeyValue+lookupKeyValue (UnsafeMkKey x) = unsafePerformIO $ do+  GlobalKeyValueMap _ im _ <- readIORef keyMap+  pure $! im IM.! x++{-# NOINLINE lookupKeyValue #-}++instance Eq Key where+  UnsafeMkKey a == UnsafeMkKey b = a == b+instance Hashable Key where+  hashWithSalt i (UnsafeMkKey x) = hashWithSalt i x+instance Show Key where+  show (Key x) = show x++renderKey :: Key -> Text+renderKey (lookupKeyValue -> KeyValue _ t) = t++newtype KeySet = KeySet IntSet+  deriving newtype (Eq, Ord, Semigroup, Monoid)++instance Show KeySet where+  showsPrec p (KeySet is)= showParen (p > 10) $+      showString "fromList " . shows ks+    where ks = coerce (IS.toList is) :: [Key]++insertKeySet :: Key -> KeySet -> KeySet+insertKeySet = coerce IS.insert++memberKeySet :: Key -> KeySet -> Bool+memberKeySet = coerce IS.member++toListKeySet :: KeySet -> [Key]+toListKeySet = coerce IS.toList++nullKeySet :: KeySet -> Bool+nullKeySet = coerce IS.null++differenceKeySet :: KeySet -> KeySet -> KeySet+differenceKeySet = coerce IS.difference++deleteKeySet :: Key -> KeySet -> KeySet+deleteKeySet = coerce IS.delete++fromListKeySet :: [Key] -> KeySet+fromListKeySet = coerce IS.fromList++singletonKeySet :: Key -> KeySet+singletonKeySet = coerce IS.singleton++filterKeySet :: (Key -> Bool) -> KeySet -> KeySet+filterKeySet = coerce IS.filter++lengthKeySet :: KeySet -> Int+lengthKeySet = coerce IS.size++newtype KeyMap a = KeyMap (IntMap a)+  deriving newtype (Eq, Ord, Semigroup, Monoid)++instance Show a => Show (KeyMap a) where+  showsPrec p (KeyMap im)= showParen (p > 10) $+      showString "fromList " . shows ks+    where ks = coerce (IM.toList im) :: [(Key,a)]++mapKeyMap :: (a -> b) -> KeyMap a -> KeyMap b+mapKeyMap f (KeyMap m) = KeyMap (IM.map f m)++insertKeyMap :: Key -> a -> KeyMap a -> KeyMap a+insertKeyMap (UnsafeMkKey k) v (KeyMap m) = KeyMap (IM.insert k v m)++lookupKeyMap :: Key -> KeyMap a -> Maybe a+lookupKeyMap (UnsafeMkKey k) (KeyMap m) = IM.lookup k m++lookupDefaultKeyMap :: a -> Key -> KeyMap a -> a+lookupDefaultKeyMap a (UnsafeMkKey k) (KeyMap m) = IM.findWithDefault a k m++fromListKeyMap :: [(Key,a)] -> KeyMap a+fromListKeyMap xs = KeyMap (IM.fromList (coerce xs))++fromListWithKeyMap :: (a -> a -> a) -> [(Key,a)] -> KeyMap a+fromListWithKeyMap f xs = KeyMap (IM.fromListWith f (coerce xs))++toListKeyMap :: KeyMap a -> [(Key,a)]+toListKeyMap (KeyMap m) = coerce (IM.toList m)++elemsKeyMap :: KeyMap a -> [a]+elemsKeyMap (KeyMap m) = IM.elems m++restrictKeysKeyMap :: KeyMap a -> KeySet -> KeyMap a+restrictKeysKeyMap (KeyMap m) (KeySet s) = KeyMap (IM.restrictKeys m s)

@@ -21,8 +21,8 @@ import           Data.Maybe import           Data.Time                               (getCurrentTime) import           Data.Time.Format.ISO8601                (iso8601Show)-import           Development.IDE.Graph.Classes import           Development.IDE.Graph.Internal.Database (getDirtySet)+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Paths import           Development.IDE.Graph.Internal.Types import qualified Language.Javascript.DGTable             as DGTable@@ -64,7 +64,7 @@ -- | Given a map of representing a dependency order (with a show for error messages), find an ordering for the items such --   that no item points to an item before itself. --   Raise an error if you end up with a cycle.--- dependencyOrder :: (Eq a, Hashable a) => (a -> String) -> [(a,[a])] -> [a]+-- -- Algorithm: --    Divide everyone up into those who have no dependencies [Id] --    And those who depend on a particular Id, Dep :-> Maybe [(Key,[Dep])]@@ -72,6 +72,7 @@ --    For each with no dependencies, add to list, then take its dep hole and --    promote them either to Nothing (if ds == []) or into a new slot. --    k :-> Nothing means the key has already been freed+dependencyOrder :: (Key -> String) -> [(Key, [Key])] -> [Key] dependencyOrder shw status =   f (map fst noDeps) $     mapKeyMap Just $@@ -88,7 +89,7 @@             where (bad,badOverflow) = splitAt 10 [shw i | (i, Just _) <- toListKeyMap mp]          f (x:xs) mp = x : f (now++xs) later-            where Just free = lookupDefaultKeyMap (Just []) x mp+            where free = fromMaybe [] $ lookupDefaultKeyMap (Just []) x mp                   (now,later) = foldl' g ([], insertKeyMap x Nothing mp) free          g (free, mp) (k, []) = (k:free, mp)

@@ -1,9 +1,8 @@ -- We deliberately want to ensure the function we add to the rule database -- has the constraints we need on it when we get it out. {-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies    #-}  module Development.IDE.Graph.Internal.Rules where @@ -18,6 +17,7 @@ import           Data.Maybe import           Data.Typeable import           Development.IDE.Graph.Classes+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Types  -- | The type mapping between the @key@ or a rule and the resulting @value@.

@@ -1,48 +1,35 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveAnyClass             #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE ExistentialQuantification  #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE PatternSynonyms            #-}-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE ViewPatterns               #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE RecordWildCards    #-}  module Development.IDE.Graph.Internal.Types where -import           Control.Applicative import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Trans.Reader-import           Data.Aeson                    (FromJSON, ToJSON)-import           Data.Bifunctor                (second)-import qualified Data.ByteString               as BS-import           Data.Coerce+import           Data.Aeson                         (FromJSON, ToJSON)+import           Data.Bifunctor                     (second)+import qualified Data.ByteString                    as BS import           Data.Dynamic-import qualified Data.HashMap.Strict           as Map-import qualified Data.IntMap.Strict            as IM-import           Data.IntMap                   (IntMap)-import qualified Data.IntSet                   as IS-import           Data.IntSet                   (IntSet)-import qualified Data.Text                     as T-import           Data.Text                     (Text)+import qualified Data.HashMap.Strict                as Map import           Data.IORef-import           Data.List                     (intercalate)+import           Data.List                          (intercalate) import           Data.Maybe import           Data.Typeable import           Development.IDE.Graph.Classes-import           GHC.Conc                      (TVar, atomically)-import           GHC.Generics                  (Generic)+import           Development.IDE.Graph.Internal.Key+import           GHC.Conc                           (TVar, atomically)+import           GHC.Generics                       (Generic) import qualified ListT-import qualified StmContainers.Map             as SMap-import           StmContainers.Map             (Map)-import           System.Time.Extra             (Seconds)-import           System.IO.Unsafe-import           UnliftIO                      (MonadUnliftIO)+import qualified StmContainers.Map                  as SMap+import           StmContainers.Map                  (Map)+import           System.Time.Extra                  (Seconds)+import           UnliftIO                           (MonadUnliftIO) +#if !MIN_VERSION_base(4,18,0)+import           Control.Applicative                (liftA2)+#endif  unwrapDynamic :: forall a . Typeable a => Dynamic -> a unwrapDynamic x = fromMaybe (error msg) $ fromDynamic x@@ -68,15 +55,14 @@     rulesMap     :: !(IORef TheRules)     } - --------------------------------------------------------------------- -- ACTIONS  -- | An action representing something that can be run as part of a 'Rule'.--- +-- -- 'Action's can be pure functions but also have access to 'IO' via 'MonadIO' and 'MonadUnliftIO. -- It should be assumed that actions throw exceptions, these can be caught with--- 'Development.IDE.Graph.Internal.Action.actionCatch'. In particular, it is +-- 'Development.IDE.Graph.Internal.Action.actionCatch'. In particular, it is -- permissible to use the 'MonadFail' instance, which will lead to an 'IOException'. newtype Action a = Action {fromAction :: ReaderT SAction IO a}     deriving newtype (Monad, Applicative, Functor, MonadIO, MonadFail, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO)@@ -101,127 +87,7 @@ --------------------------------------------------------------------- -- Keys -data KeyValue = forall a . (Eq a, Typeable a, Hashable a, Show a) => KeyValue a Text -newtype Key = UnsafeMkKey Int--pattern Key a <- (lookupKeyValue -> KeyValue a _)--data GlobalKeyValueMap = GlobalKeyValueMap !(Map.HashMap KeyValue Key) !(IntMap KeyValue) {-# UNPACK #-} !Int--keyMap :: IORef GlobalKeyValueMap-keyMap = unsafePerformIO $ newIORef (GlobalKeyValueMap Map.empty IM.empty 0)--{-# NOINLINE keyMap #-}--newKey :: (Eq a, Typeable a, Hashable a, Show a) => a -> Key-newKey k = unsafePerformIO $ do-  let !newKey = KeyValue k (T.pack (show k))-  atomicModifyIORef' keyMap $ \km@(GlobalKeyValueMap hm im n) ->-    let new_key = Map.lookup newKey hm-    in case new_key of-          Just v  -> (km, v)-          Nothing ->-            let !new_index = UnsafeMkKey n-            in (GlobalKeyValueMap (Map.insert newKey new_index hm) (IM.insert n newKey im) (n+1), new_index)-{-# NOINLINE newKey #-}--lookupKeyValue :: Key -> KeyValue-lookupKeyValue (UnsafeMkKey x) = unsafePerformIO $ do-  GlobalKeyValueMap _ im _ <- readIORef keyMap-  pure $! im IM.! x--{-# NOINLINE lookupKeyValue #-}--instance Eq Key where-  UnsafeMkKey a == UnsafeMkKey b = a == b-instance Hashable Key where-  hashWithSalt i (UnsafeMkKey x) = hashWithSalt i x-instance Show Key where-  show (Key x) = show x--instance Eq KeyValue where-    KeyValue a _ == KeyValue b _ = Just a == cast b-instance Hashable KeyValue where-    hashWithSalt i (KeyValue x _) = hashWithSalt i (typeOf x, x)-instance Show KeyValue where-    show (KeyValue x t) = T.unpack t--renderKey :: Key -> Text-renderKey (lookupKeyValue -> KeyValue _ t) = t--newtype KeySet = KeySet IntSet-  deriving newtype (Eq, Ord, Semigroup, Monoid)--instance Show KeySet where-  showsPrec p (KeySet is)= showParen (p > 10) $-      showString "fromList " . shows ks-    where ks = coerce (IS.toList is) :: [Key]--insertKeySet :: Key -> KeySet -> KeySet-insertKeySet = coerce IS.insert--memberKeySet :: Key -> KeySet -> Bool-memberKeySet = coerce IS.member--toListKeySet :: KeySet -> [Key]-toListKeySet = coerce IS.toList--nullKeySet :: KeySet -> Bool-nullKeySet = coerce IS.null--differenceKeySet :: KeySet -> KeySet -> KeySet-differenceKeySet = coerce IS.difference--deleteKeySet :: Key -> KeySet -> KeySet-deleteKeySet = coerce IS.delete--fromListKeySet :: [Key] -> KeySet-fromListKeySet = coerce IS.fromList--singletonKeySet :: Key -> KeySet-singletonKeySet = coerce IS.singleton--filterKeySet :: (Key -> Bool) -> KeySet -> KeySet-filterKeySet = coerce IS.filter--lengthKeySet :: KeySet -> Int-lengthKeySet = coerce IS.size--newtype KeyMap a = KeyMap (IntMap a)-  deriving newtype (Eq, Ord, Semigroup, Monoid)--instance Show a => Show (KeyMap a) where-  showsPrec p (KeyMap im)= showParen (p > 10) $-      showString "fromList " . shows ks-    where ks = coerce (IM.toList im) :: [(Key,a)]--mapKeyMap :: (a -> b) -> KeyMap a -> KeyMap b-mapKeyMap f (KeyMap m) = KeyMap (IM.map f m)--insertKeyMap :: Key -> a -> KeyMap a -> KeyMap a-insertKeyMap (UnsafeMkKey k) v (KeyMap m) = KeyMap (IM.insert k v m)--lookupKeyMap :: Key -> KeyMap a -> Maybe a-lookupKeyMap (UnsafeMkKey k) (KeyMap m) = IM.lookup k m--lookupDefaultKeyMap :: a -> Key -> KeyMap a -> a-lookupDefaultKeyMap a (UnsafeMkKey k) (KeyMap m) = IM.findWithDefault a k m--fromListKeyMap :: [(Key,a)] -> KeyMap a-fromListKeyMap xs = KeyMap (IM.fromList (coerce xs))--fromListWithKeyMap :: (a -> a -> a) -> [(Key,a)] -> KeyMap a-fromListWithKeyMap f xs = KeyMap (IM.fromListWith f (coerce xs))--toListKeyMap :: KeyMap a -> [(Key,a)]-toListKeyMap (KeyMap m) = coerce (IM.toList m)--elemsKeyMap :: KeyMap a -> [a]-elemsKeyMap (KeyMap m) = IM.elems m--restrictKeysKeyMap :: KeyMap a -> KeySet -> KeyMap a-restrictKeysKeyMap (KeyMap m) (KeySet s) = KeyMap (IM.restrictKeys m s)   newtype Value = Value Dynamic

@@ -12,4 +12,4 @@       restrictKeysKeyMap,     ) where -import Development.IDE.Graph.Internal.Types+import           Development.IDE.Graph.Internal.Key

@@ -13,4 +13,4 @@       lengthKeySet,     ) where -import Development.IDE.Graph.Internal.Types+import           Development.IDE.Graph.Internal.Key

@@ -1,21 +1,17 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}  module ActionSpec where  import           Control.Concurrent.STM-import qualified Data.HashSet                          as HashSet-import           Development.IDE.Graph                 (shakeOptions)-import           Development.IDE.Graph.Database        (shakeNewDatabase,-                                                        shakeRunDatabase)-import           Development.IDE.Graph.Internal.Action (apply1)+import           Development.IDE.Graph                (shakeOptions)+import           Development.IDE.Graph.Database       (shakeNewDatabase,+                                                       shakeRunDatabase)+import           Development.IDE.Graph.Internal.Key import           Development.IDE.Graph.Internal.Types import           Development.IDE.Graph.Rule import           Example-import qualified StmContainers.Map                     as STM-import           System.Time.Extra                     (timeout)+import qualified StmContainers.Map                    as STM import           Test.Hspec  spec :: Spec@@ -58,14 +54,14 @@       keyReverseDeps `shouldBe` (singletonKeySet $ newKey theKey)     it "rethrows exceptions" $ do       db <- shakeNewDatabase shakeOptions $ do-        addRule $ \(Rule :: Rule ()) old mode -> error "boom"+        addRule $ \(Rule :: Rule ()) _old _mode -> error "boom"       let res = shakeRunDatabase db $ pure $ apply1 (Rule @())       res `shouldThrow` anyErrorCall   describe "applyWithoutDependency" $ do     it "does not track dependencies" $ do       db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do         ruleUnit-        addRule $ \Rule old mode -> do+        addRule $ \Rule _old _mode -> do             [()] <- applyWithoutDependency [Rule]             return $ RunResult ChangedRecomputeDiff "" True 

@@ -1,19 +1,14 @@-{-# LANGUAGE OverloadedLists     #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE OverloadedStrings #-}+ module DatabaseSpec where -import           Control.Concurrent.STM import           Development.IDE.Graph                 (shakeOptions) import           Development.IDE.Graph.Database        (shakeNewDatabase,                                                         shakeRunDatabase) import           Development.IDE.Graph.Internal.Action (apply1)+import           Development.IDE.Graph.Internal.Rules  (addRule) import           Development.IDE.Graph.Internal.Types-import           Development.IDE.Graph.Rule import           Example-import qualified StmContainers.Map                     as STM import           System.Time.Extra                     (timeout) import           Test.Hspec @@ -23,7 +18,7 @@         it "detects cycles" $ do             db <- shakeNewDatabase shakeOptions $ do                 ruleBool-                addRule $ \Rule old mode -> do+                addRule $ \Rule _old _mode -> do                     True <- apply1 (Rule @Bool)                     return $ RunResult ChangedRecomputeDiff "" ()             let res = shakeRunDatabase db $ pure $ apply1 (Rule @())

@@ -1,9 +1,7 @@-{-# LANGUAGE DeriveAnyClass      #-}-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE NoPolyKinds       #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies      #-} module Example where  import           Development.IDE.Graph@@ -21,11 +19,11 @@ type instance RuleResult (Rule a) = a  ruleUnit :: Rules ()-ruleUnit = addRule $ \(Rule :: Rule ()) old mode -> do+ruleUnit = addRule $ \(Rule :: Rule ()) _old _mode -> do     return $ RunResult ChangedRecomputeDiff "" ()  -- | Depends on Rule @() ruleBool :: Rules ()-ruleBool = addRule $ \Rule old mode -> do+ruleBool = addRule $ \Rule _old _mode -> do     () <- apply1 Rule     return $ RunResult ChangedRecomputeDiff "" True