Fix warnings in hls-graph, enable pedantic in CI (#4047)

* Fix warnings in hls-graph, enable pedantic in CI

* Fix build with flags

* stylish-haskell

* Split Key stuff to separate module with explicit export list

* Try the cabal configure suggestion in CI flags job

* Newline fix

* Enable pedantic for all

* Typo

* stylish-haskell

* pedantic is already enabled for all

* Fix error in hls-plugin-api

* Address nitpick, use lsp-types in tests instead

.github/workflows/flags.yml

@@ -69,14 +69,21 @@ jobs:
           ghc: ${{ matrix.ghc }}
           os:  ${{ runner.os }}
 
-      - name: Build `hls-graph` with flags
-        run: cabal v2-build hls-graph --flags="embed-files stm-stats"
+      # The purpose of this job is to ensure that the build works even with flags
+      # in their non-default settings. Below we:
+      # - enable flags that are off by default
+      # - disable flags that are on by default
+      - name: Configue non-default flags for all components
+        run: |
+          cabal configure \
+              --constraint "hls-graph +embed-files +stm-stats" \
+              --constraint "ghcide +ekg +executable +test-exe" \
+              --constraint "hls-plugin-api -use-fingertree" \
+              --constraint "all +pedantic"
+          cat cabal.project.local
 
-      - name: Build `ghcide` with flags
-        run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg"
-
-      - name: Build with pedantic (-WError)
-        run: cabal v2-build --flags="pedantic"
+      - name: Build everything with non-default flags
+        run: cabal build all
 
   flags_post_job:
     if: always()

.hlint.yaml

@@ -60,7 +60,7 @@
     - Development.IDE.Graph.Internal.Database
     - Development.IDE.Graph.Internal.Paths
     - Development.IDE.Graph.Internal.Profile
-    - Development.IDE.Graph.Internal.Types
+    - Development.IDE.Graph.Internal.Key
     - Ide.Types
     - Test.Hls
     - Test.Hls.Command

ghcide/src/Development/IDE/Types/Shake.hs

@@ -24,8 +24,8 @@ import           Data.Typeable                        (cast)
 import           Data.Vector                          (Vector)
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.RuleTypes       (FileVersion)
-import           Development.IDE.Graph                (Key (..), RuleResult,
-                                                       newKey)
+import           Development.IDE.Graph                (Key, RuleResult, newKey,
+                                                       pattern Key)
 import qualified Development.IDE.Graph                as Shake
 import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Location

hls-graph/hls-graph.cabal

@@ -39,7 +39,16 @@ source-repository head
   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 @@ library
     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 @@ library
     , bytestring
     , containers
     , deepseq
-    , directory
     , exceptions
     , extra
     , filepath
@@ -89,14 +98,13 @@ library
     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
 
@@ -105,6 +113,7 @@ library
     DataKinds
 
 test-suite tests
+  import: warnings
   type:               exitcode-stdio-1.0
   default-language:   GHC2021
   hs-source-dirs:     test
@@ -118,23 +127,16 @@ test-suite tests
 
   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

hls-graph/src/Development/IDE/Graph.hs

@@ -3,7 +3,7 @@ module Development.IDE.Graph(
       shakeOptions,
     Rules,
     Action, action,
-    Key(.., Key),
+    pattern Key,
     newKey, renderKey,
     actionFinally, actionBracket, actionCatch, actionFork,
     -- * Configuration
@@ -25,9 +25,10 @@ module Development.IDE.Graph(
     ) 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

hls-graph/src/Development/IDE/Graph/Database.hs

@@ -16,6 +16,7 @@ import           Data.Maybe
 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

hls-graph/src/Development/IDE/Graph/Internal/Action.hs

@@ -27,6 +27,7 @@ import           Data.Functor.Identity
 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

hls-graph/src/Development/IDE/Graph/Internal/Database.hs

@@ -33,6 +33,7 @@ import           Data.Traversable                     (for)
 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

hls-graph/src/Development/IDE/Graph/Internal/Key.hs

@@ -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)

hls-graph/src/Development/IDE/Graph/Internal/Profile.hs

@@ -22,6 +22,7 @@ import           Data.Maybe
 import           Data.Time                               (getCurrentTime)
 import           Data.Time.Format.ISO8601                (iso8601Show)
 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
@@ -63,7 +64,7 @@ resultsOnly mp = mapKeyMap (\r ->
 -- | 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])]
@@ -71,6 +72,7 @@ resultsOnly mp = mapKeyMap (\r ->
 --    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 $
@@ -87,7 +89,7 @@ dependencyOrder shw status =
             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)

hls-graph/src/Development/IDE/Graph/Internal/Rules.hs

@@ -17,6 +17,7 @@ import           Data.IORef
 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@.

hls-graph/src/Development/IDE/Graph/Internal/Types.hs

@@ -1,43 +1,34 @@
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE PatternSynonyms    #-}
 {-# LANGUAGE RecordWildCards    #-}
-{-# LANGUAGE ViewPatterns       #-}
 
 module Development.IDE.Graph.Internal.Types where
 
 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           Data.IntMap                   (IntMap)
-import qualified Data.IntMap.Strict            as IM
-import           Data.IntSet                   (IntSet)
-import qualified Data.IntSet                   as IS
+import qualified Data.HashMap.Strict                as Map
 import           Data.IORef
-import           Data.List                     (intercalate)
+import           Data.List                          (intercalate)
 import           Data.Maybe
-import           Data.Text                     (Text)
-import qualified Data.Text                     as T
 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.IO.Unsafe
-import           System.Time.Extra             (Seconds)
-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)
+import           Control.Applicative                (liftA2)
 #endif
 
 unwrapDynamic :: forall a . Typeable a => Dynamic -> a
@@ -64,7 +55,6 @@ data SRules = SRules {
     rulesMap     :: !(IORef TheRules)
     }
 
-
 ---------------------------------------------------------------------
 -- ACTIONS
 
@@ -97,127 +87,7 @@ newtype Step = Step Int
 ---------------------------------------------------------------------
 -- 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 :: (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

hls-graph/src/Development/IDE/Graph/KeyMap.hs

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

hls-graph/src/Development/IDE/Graph/KeySet.hs

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

hls-graph/test/ActionSpec.hs

@@ -4,16 +4,14 @@
 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
@@ -56,14 +54,14 @@ spec = do
       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
 

hls-graph/test/DatabaseSpec.hs

@@ -1,17 +1,14 @@
-{-# LANGUAGE OverloadedLists   #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+
 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
 
@@ -21,7 +18,7 @@ spec = do
         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 @())

hls-graph/test/Example.hs

@@ -19,11 +19,11 @@ instance Typeable a => Show (Rule a) where
 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

hls-plugin-api/bench/Main.hs

@@ -2,17 +2,17 @@
 -- vs RangeMap-based "in-range filtering" approaches
 module Main (main) where
 
-import           Control.DeepSeq        (force)
-import           Control.Exception      (evaluate)
-import           Control.Monad          (replicateM)
+import           Control.DeepSeq             (force)
+import           Control.Exception           (evaluate)
+import           Control.Monad               (replicateM)
 import qualified Criterion
 import qualified Criterion.Main
-import           Data.Random            (RVar)
-import qualified Data.Random            as Fu
-import qualified Ide.Plugin.RangeMap    as RangeMap
-import           Language.LSP.Types     (Position (..), Range (..), UInt,
-                                         isSubrangeOf)
-import qualified System.Random.Stateful as Random
+import           Data.Random                 (RVar)
+import qualified Data.Random                 as Fu
+import qualified Ide.Plugin.RangeMap         as RangeMap
+import           Language.LSP.Protocol.Types (Position (..), Range (..), UInt,
+                                              isSubrangeOf)
+import qualified System.Random.Stateful      as Random
 
 
 genRangeList :: Int -> RVar [Range]

hls-plugin-api/src/Ide/Plugin/RangeMap.hs

@@ -14,14 +14,16 @@ module Ide.Plugin.RangeMap
     fromList',
     filterByRange,
   ) where
+
 import           Development.IDE.Graph.Classes            (NFData)
-import           Language.LSP.Protocol.Types              (Range, isSubrangeOf)
 #ifdef USE_FINGERTREE
 import           Data.Bifunctor                           (first)
 import           Data.Foldable                            (foldl')
 import qualified HaskellWorks.Data.IntervalMap.FingerTree as IM
 import           Language.LSP.Protocol.Types              (Position,
                                                            Range (Range))
+#else
+import           Language.LSP.Protocol.Types              (Range, isSubrangeOf)
 #endif
 
 -- | A map from code ranges to values.