{-# 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
data KnownTargets = KnownTargets
{ KnownTargets -> HashMap Target (HashSet NormalizedFilePath)
targetMap :: !(HashMap Target (HashSet NormalizedFilePath))
, 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