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

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

-- | A mapping of module name to known files

type KnownTargets = HashMap Target [NormalizedFilePath]

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
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, (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
$cto :: forall x. Rep Target x -> Target
$cfrom :: forall x. Target -> Rep Target x
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
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show )
  deriving anyclass (Int -> Target -> Int
Target -> Int
(Int -> Target -> Int) -> (Target -> Int) -> Hashable Target
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Target -> Int
$chash :: Target -> Int
hashWithSalt :: Int -> Target -> Int
$chashWithSalt :: Int -> Target -> Int
Hashable, Target -> ()
(Target -> ()) -> NFData Target
forall a. (a -> ()) -> NFData a
rnf :: Target -> ()
$crnf :: Target -> ()
NFData)

toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
toKnownFiles = [NormalizedFilePath] -> HashSet NormalizedFilePath
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HSet.fromList ([NormalizedFilePath] -> HashSet NormalizedFilePath)
-> (KnownTargets -> [NormalizedFilePath])
-> KnownTargets
-> HashSet NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[NormalizedFilePath]] -> [NormalizedFilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[NormalizedFilePath]] -> [NormalizedFilePath])
-> (KnownTargets -> [[NormalizedFilePath]])
-> KnownTargets
-> [NormalizedFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownTargets -> [[NormalizedFilePath]]
forall k v. HashMap k v -> [v]
HMap.elems