{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
module Development.IDE.Types.KnownTargets ( KnownTargets(..)
                                          , emptyKnownTargets
                                          , mkKnownTargets
                                          , unionKnownTargets
                                          , Target(..)
                                          , toKnownFiles) where

import           Control.DeepSeq
import           Data.Hashable
import           Data.HashMap.Strict
import qualified Data.HashMap.Strict            as HMap
import           Data.HashSet
import qualified Data.HashSet                   as HSet
import           Development.IDE.GHC.Compat     (ModuleName)
import           Development.IDE.GHC.Orphans    ()
import           Development.IDE.Types.Location
import           GHC.Generics

-- | A mapping of module name to known files
data KnownTargets = KnownTargets
  { KnownTargets -> HashMap Target (HashSet NormalizedFilePath)
targetMap      :: !(HashMap Target (HashSet NormalizedFilePath))
  -- | 'normalisingMap' is a cached copy of `HMap.mapKey const targetMap`
  --
  -- At startup 'GetLocatedImports' is called on all known files. Say you have 10000
  -- modules in your project then this leads to 10000 calls to 'GetLocatedImports'
  -- running concurrently.
  --
  -- In `GetLocatedImports` the known targets are consulted and the targetsMap
  -- is created by mapping the known targets. This map is used for introducing
  -- sharing amongst filepaths.  This operation copies a local copy of the `target`
  --  map which is local to the rule.
  --
  -- @
  -- let targetsMap = HMap.mapWithKey const targets
  -- @
  --
  -- So now each rule has a 'HashMap' of size 10000 held locally to it and depending
  -- on how the threads are scheduled there will be 10000^2 elements in total
  -- allocated in 'HashMap's. This used a lot of memory.
  --
  -- Solution: Return the 'normalisingMap' in the result of the `GetKnownTargets` rule so it is shared across threads.
  , KnownTargets -> HashMap Target Target
normalisingMap :: !(HashMap Target Target) } deriving Int -> KnownTargets -> ShowS
[KnownTargets] -> ShowS
KnownTargets -> String
(Int -> KnownTargets -> ShowS)
-> (KnownTargets -> String)
-> ([KnownTargets] -> ShowS)
-> Show KnownTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KnownTargets -> ShowS
showsPrec :: Int -> KnownTargets -> ShowS
$cshow :: KnownTargets -> String
show :: KnownTargets -> String
$cshowList :: [KnownTargets] -> ShowS
showList :: [KnownTargets] -> ShowS
Show


unionKnownTargets :: KnownTargets -> KnownTargets -> KnownTargets
unionKnownTargets :: KnownTargets -> KnownTargets -> KnownTargets
unionKnownTargets (KnownTargets HashMap Target (HashSet NormalizedFilePath)
tm HashMap Target Target
nm) (KnownTargets HashMap Target (HashSet NormalizedFilePath)
tm' HashMap Target Target
nm') =
  HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target Target -> KnownTargets
KnownTargets ((HashSet NormalizedFilePath
 -> HashSet NormalizedFilePath -> HashSet NormalizedFilePath)
-> HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target (HashSet NormalizedFilePath)
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HMap.unionWith HashSet NormalizedFilePath
-> HashSet NormalizedFilePath -> HashSet NormalizedFilePath
forall a. Semigroup a => a -> a -> a
(<>) HashMap Target (HashSet NormalizedFilePath)
tm HashMap Target (HashSet NormalizedFilePath)
tm') (HashMap Target Target
-> HashMap Target Target -> HashMap Target Target
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
HMap.union HashMap Target Target
nm HashMap Target Target
nm')

mkKnownTargets :: [(Target, HashSet NormalizedFilePath)] -> KnownTargets
mkKnownTargets :: [(Target, HashSet NormalizedFilePath)] -> KnownTargets
mkKnownTargets [(Target, HashSet NormalizedFilePath)]
vs = HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target Target -> KnownTargets
KnownTargets ([(Target, HashSet NormalizedFilePath)]
-> HashMap Target (HashSet NormalizedFilePath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(Target, HashSet NormalizedFilePath)]
vs) ([(Target, Target)] -> HashMap Target Target
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(Target
k,Target
k) | (Target
k,HashSet NormalizedFilePath
_) <- [(Target, HashSet NormalizedFilePath)]
vs ])

instance NFData KnownTargets where
  rnf :: KnownTargets -> ()
rnf (KnownTargets HashMap Target (HashSet NormalizedFilePath)
tm HashMap Target Target
nm) = HashMap Target (HashSet NormalizedFilePath) -> ()
forall a. NFData a => a -> ()
rnf HashMap Target (HashSet NormalizedFilePath)
tm () -> () -> ()
forall a b. a -> b -> b
`seq` HashMap Target Target -> ()
forall a. NFData a => a -> ()
rnf HashMap Target Target
nm () -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance Eq KnownTargets where
  KnownTargets
k1 == :: KnownTargets -> KnownTargets -> Bool
== KnownTargets
k2 = KnownTargets -> HashMap Target (HashSet NormalizedFilePath)
targetMap KnownTargets
k1 HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target (HashSet NormalizedFilePath) -> Bool
forall a. Eq a => a -> a -> Bool
== KnownTargets -> HashMap Target (HashSet NormalizedFilePath)
targetMap KnownTargets
k2

instance Hashable KnownTargets where
  hashWithSalt :: Int -> KnownTargets -> Int
hashWithSalt Int
s (KnownTargets HashMap Target (HashSet NormalizedFilePath)
hm HashMap Target Target
_) = Int -> HashMap Target (HashSet NormalizedFilePath) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s HashMap Target (HashSet NormalizedFilePath)
hm

emptyKnownTargets :: KnownTargets
emptyKnownTargets :: KnownTargets
emptyKnownTargets = HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target Target -> KnownTargets
KnownTargets HashMap Target (HashSet NormalizedFilePath)
forall k v. HashMap k v
HMap.empty HashMap Target Target
forall k v. HashMap k v
HMap.empty

data Target = TargetModule ModuleName | TargetFile NormalizedFilePath
  deriving ( Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq, Eq Target
Eq Target =>
(Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$c< :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> Target
Ord, (forall x. Target -> Rep Target x)
-> (forall x. Rep Target x -> Target) -> Generic Target
forall x. Rep Target x -> Target
forall x. Target -> Rep Target x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Target -> Rep Target x
from :: forall x. Target -> Rep Target x
$cto :: forall x. Rep Target x -> Target
to :: forall x. Rep Target x -> Target
Generic, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
Show )
  deriving anyclass (Eq Target
Eq Target =>
(Int -> Target -> Int) -> (Target -> Int) -> Hashable Target
Int -> Target -> Int
Target -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Target -> Int
hashWithSalt :: Int -> Target -> Int
$chash :: Target -> Int
hash :: Target -> Int
Hashable, Target -> ()
(Target -> ()) -> NFData Target
forall a. (a -> ()) -> NFData a
$crnf :: Target -> ()
rnf :: Target -> ()
NFData)

toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
toKnownFiles = [HashSet NormalizedFilePath] -> HashSet NormalizedFilePath
forall a. Eq a => [HashSet a] -> HashSet a
HSet.unions ([HashSet NormalizedFilePath] -> HashSet NormalizedFilePath)
-> (KnownTargets -> [HashSet NormalizedFilePath])
-> KnownTargets
-> HashSet NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Target (HashSet NormalizedFilePath)
-> [HashSet NormalizedFilePath]
forall k v. HashMap k v -> [v]
HMap.elems (HashMap Target (HashSet NormalizedFilePath)
 -> [HashSet NormalizedFilePath])
-> (KnownTargets -> HashMap Target (HashSet NormalizedFilePath))
-> KnownTargets
-> [HashSet NormalizedFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownTargets -> HashMap Target (HashSet NormalizedFilePath)
targetMap