module Hix.Managed.Data.Targets (
  Targets (Targets),
  unsafeTargets,
  getTargets,
  targetsSet,
  singleTarget,
  sortTargets,
  allMTargets,
  firstMTargets,
  overTargets,
) where

import Data.Aeson (FromJSON, FromJSONKey)
import Data.Foldable.Extra (allM)
import Data.Graph (Graph, Vertex, graphFromEdges, reverseTopSort)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Distribution.Pretty (Pretty)

import Hix.Class.EncodeNix (EncodeNixKey)
import Hix.Class.Map (nGet, nMap, nMapWithKey, nRestrictKeys)
import Hix.Data.PackageName (LocalPackage (LocalPackage))
import Hix.Managed.Data.Packages (Packages)

newtype EnvMember =
  EnvMember LocalPackage
  deriving stock (EnvMember -> EnvMember -> Bool
(EnvMember -> EnvMember -> Bool)
-> (EnvMember -> EnvMember -> Bool) -> Eq EnvMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvMember -> EnvMember -> Bool
== :: EnvMember -> EnvMember -> Bool
$c/= :: EnvMember -> EnvMember -> Bool
/= :: EnvMember -> EnvMember -> Bool
Eq, Int -> EnvMember -> ShowS
[EnvMember] -> ShowS
EnvMember -> String
(Int -> EnvMember -> ShowS)
-> (EnvMember -> String)
-> ([EnvMember] -> ShowS)
-> Show EnvMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvMember -> ShowS
showsPrec :: Int -> EnvMember -> ShowS
$cshow :: EnvMember -> String
show :: EnvMember -> String
$cshowList :: [EnvMember] -> ShowS
showList :: [EnvMember] -> ShowS
Show, (forall x. EnvMember -> Rep EnvMember x)
-> (forall x. Rep EnvMember x -> EnvMember) -> Generic EnvMember
forall x. Rep EnvMember x -> EnvMember
forall x. EnvMember -> Rep EnvMember x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvMember -> Rep EnvMember x
from :: forall x. EnvMember -> Rep EnvMember x
$cto :: forall x. Rep EnvMember x -> EnvMember
to :: forall x. Rep EnvMember x -> EnvMember
Generic)
  deriving newtype (String -> EnvMember
(String -> EnvMember) -> IsString EnvMember
forall a. (String -> a) -> IsString a
$cfromString :: String -> EnvMember
fromString :: String -> EnvMember
IsString, Eq EnvMember
Eq EnvMember =>
(EnvMember -> EnvMember -> Ordering)
-> (EnvMember -> EnvMember -> Bool)
-> (EnvMember -> EnvMember -> Bool)
-> (EnvMember -> EnvMember -> Bool)
-> (EnvMember -> EnvMember -> Bool)
-> (EnvMember -> EnvMember -> EnvMember)
-> (EnvMember -> EnvMember -> EnvMember)
-> Ord EnvMember
EnvMember -> EnvMember -> Bool
EnvMember -> EnvMember -> Ordering
EnvMember -> EnvMember -> EnvMember
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 :: EnvMember -> EnvMember -> Ordering
compare :: EnvMember -> EnvMember -> Ordering
$c< :: EnvMember -> EnvMember -> Bool
< :: EnvMember -> EnvMember -> Bool
$c<= :: EnvMember -> EnvMember -> Bool
<= :: EnvMember -> EnvMember -> Bool
$c> :: EnvMember -> EnvMember -> Bool
> :: EnvMember -> EnvMember -> Bool
$c>= :: EnvMember -> EnvMember -> Bool
>= :: EnvMember -> EnvMember -> Bool
$cmax :: EnvMember -> EnvMember -> EnvMember
max :: EnvMember -> EnvMember -> EnvMember
$cmin :: EnvMember -> EnvMember -> EnvMember
min :: EnvMember -> EnvMember -> EnvMember
Ord, Maybe EnvMember
Value -> Parser [EnvMember]
Value -> Parser EnvMember
(Value -> Parser EnvMember)
-> (Value -> Parser [EnvMember])
-> Maybe EnvMember
-> FromJSON EnvMember
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser EnvMember
parseJSON :: Value -> Parser EnvMember
$cparseJSONList :: Value -> Parser [EnvMember]
parseJSONList :: Value -> Parser [EnvMember]
$comittedField :: Maybe EnvMember
omittedField :: Maybe EnvMember
FromJSON, FromJSONKeyFunction [EnvMember]
FromJSONKeyFunction EnvMember
FromJSONKeyFunction EnvMember
-> FromJSONKeyFunction [EnvMember] -> FromJSONKey EnvMember
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction EnvMember
fromJSONKey :: FromJSONKeyFunction EnvMember
$cfromJSONKeyList :: FromJSONKeyFunction [EnvMember]
fromJSONKeyList :: FromJSONKeyFunction [EnvMember]
FromJSONKey, CabalSpecVersion -> EnvMember -> Doc
EnvMember -> Doc
(EnvMember -> Doc)
-> (CabalSpecVersion -> EnvMember -> Doc) -> Pretty EnvMember
forall a. (a -> Doc) -> (CabalSpecVersion -> a -> Doc) -> Pretty a
$cpretty :: EnvMember -> Doc
pretty :: EnvMember -> Doc
$cprettyVersioned :: CabalSpecVersion -> EnvMember -> Doc
prettyVersioned :: CabalSpecVersion -> EnvMember -> Doc
Pretty, EnvMember -> Text
(EnvMember -> Text) -> EncodeNixKey EnvMember
forall a. (a -> Text) -> EncodeNixKey a
$cencodeNixKey :: EnvMember -> Text
encodeNixKey :: EnvMember -> Text
EncodeNixKey)

newtype Targets =
  UnsafeTargets [LocalPackage]
  deriving stock (Targets -> Targets -> Bool
(Targets -> Targets -> Bool)
-> (Targets -> Targets -> Bool) -> Eq Targets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Targets -> Targets -> Bool
== :: Targets -> Targets -> Bool
$c/= :: Targets -> Targets -> Bool
/= :: Targets -> Targets -> Bool
Eq, Int -> Targets -> ShowS
[Targets] -> ShowS
Targets -> String
(Int -> Targets -> ShowS)
-> (Targets -> String) -> ([Targets] -> ShowS) -> Show Targets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Targets -> ShowS
showsPrec :: Int -> Targets -> ShowS
$cshow :: Targets -> String
show :: Targets -> String
$cshowList :: [Targets] -> ShowS
showList :: [Targets] -> ShowS
Show)

pattern Targets :: [LocalPackage] -> Targets
pattern $mTargets :: forall {r}. Targets -> ([LocalPackage] -> r) -> ((# #) -> r) -> r
Targets pkgs <- UnsafeTargets pkgs

{-# complete Targets #-}

unsafeTargets :: [LocalPackage] -> Targets
unsafeTargets :: [LocalPackage] -> Targets
unsafeTargets = [LocalPackage] -> Targets
UnsafeTargets

singleTarget :: LocalPackage -> Targets
singleTarget :: LocalPackage -> Targets
singleTarget = [LocalPackage] -> Targets
UnsafeTargets ([LocalPackage] -> Targets)
-> (LocalPackage -> [LocalPackage]) -> LocalPackage -> Targets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalPackage -> [LocalPackage]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance IsString Targets where
  fromString :: String -> Targets
fromString = LocalPackage -> Targets
singleTarget (LocalPackage -> Targets)
-> (String -> LocalPackage) -> String -> Targets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LocalPackage
forall a. IsString a => String -> a
fromString

getTargets :: Targets -> [LocalPackage]
getTargets :: Targets -> [LocalPackage]
getTargets (Targets [LocalPackage]
pkgs) = [LocalPackage]
pkgs

targetsSet :: Targets -> Set LocalPackage
targetsSet :: Targets -> Set LocalPackage
targetsSet (Targets [LocalPackage]
targets) =
  [LocalPackage] -> Set LocalPackage
forall a. Ord a => [a] -> Set a
Set.fromList [LocalPackage]
targets

graph ::
  Map LocalPackage [LocalPackage] ->
  (Graph, Vertex -> (LocalPackage, LocalPackage, [LocalPackage]), LocalPackage -> Maybe Vertex)
graph :: Map LocalPackage [LocalPackage]
-> (Graph, Int -> (LocalPackage, LocalPackage, [LocalPackage]),
    LocalPackage -> Maybe Int)
graph Map LocalPackage [LocalPackage]
deps =
  [(LocalPackage, LocalPackage, [LocalPackage])]
-> (Graph, Int -> (LocalPackage, LocalPackage, [LocalPackage]),
    LocalPackage -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges [(LocalPackage, LocalPackage, [LocalPackage])]
keyAssoc
  where
    keyAssoc :: [(LocalPackage, LocalPackage, [LocalPackage])]
keyAssoc = Map LocalPackage [LocalPackage] -> [(LocalPackage, [LocalPackage])]
forall k a. Map k a -> [(k, a)]
Map.toList Map LocalPackage [LocalPackage]
deps [(LocalPackage, [LocalPackage])]
-> ((LocalPackage, [LocalPackage])
    -> (LocalPackage, LocalPackage, [LocalPackage]))
-> [(LocalPackage, LocalPackage, [LocalPackage])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ (LocalPackage
p, [LocalPackage]
ds) -> (LocalPackage
p, LocalPackage
p, [LocalPackage]
ds)

onlyFrom :: Set LocalPackage -> [LocalPackage] -> [LocalPackage]
onlyFrom :: Set LocalPackage -> [LocalPackage] -> [LocalPackage]
onlyFrom Set LocalPackage
targets [LocalPackage]
deps =
  (LocalPackage -> Maybe LocalPackage)
-> [LocalPackage] -> [LocalPackage]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LocalPackage -> Maybe LocalPackage
isTarget [LocalPackage]
deps
  where
    isTarget :: LocalPackage -> Maybe LocalPackage
isTarget = \case
      LocalPackage
dep | LocalPackage -> Set LocalPackage -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member LocalPackage
dep Set LocalPackage
targets -> LocalPackage -> Maybe LocalPackage
forall a. a -> Maybe a
Just LocalPackage
dep
      LocalPackage
_ -> Maybe LocalPackage
forall a. Maybe a
Nothing

sortTargets ::
  Packages [LocalPackage] ->
  [LocalPackage] ->
  Targets
sortTargets :: Packages [LocalPackage] -> [LocalPackage] -> Targets
sortTargets Packages [LocalPackage]
deps [LocalPackage]
targets =
  [LocalPackage] -> Targets
UnsafeTargets (Graph -> [Int]
reverseTopSort Graph
g [Int] -> (Int -> LocalPackage) -> [LocalPackage]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Int
v -> let (LocalPackage
n, LocalPackage
_, [LocalPackage]
_) = Int -> (LocalPackage, LocalPackage, [LocalPackage])
get Int
v in LocalPackage
n)
  where
    (Graph
g, Int -> (LocalPackage, LocalPackage, [LocalPackage])
get, LocalPackage -> Maybe Int
_) = Map LocalPackage [LocalPackage]
-> (Graph, Int -> (LocalPackage, LocalPackage, [LocalPackage]),
    LocalPackage -> Maybe Int)
graph (Packages [LocalPackage] -> Map LocalPackage [LocalPackage]
forall map k v sort. NMap map k v sort => map -> Map k v
nGet Packages [LocalPackage]
simple)
    simple :: Packages [LocalPackage]
    simple :: Packages [LocalPackage]
simple = ([LocalPackage] -> [LocalPackage])
-> Packages [LocalPackage] -> Packages [LocalPackage]
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap (Set LocalPackage -> [LocalPackage] -> [LocalPackage]
onlyFrom Set LocalPackage
targetSet) (Set LocalPackage
-> Packages [LocalPackage] -> Packages [LocalPackage]
forall map k v sort. NMap map k v sort => Set k -> map -> map
nRestrictKeys Set LocalPackage
targetSet Packages [LocalPackage]
deps)
    targetSet :: Set LocalPackage
targetSet = [LocalPackage] -> Set LocalPackage
forall a. Ord a => [a] -> Set a
Set.fromList [LocalPackage]
targets

firstMTargets ::
  Monad m =>
  a ->
  (a -> Bool) ->
  (LocalPackage -> m a) ->
  Targets ->
  m a
firstMTargets :: forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool) -> (LocalPackage -> m a) -> Targets -> m a
firstMTargets a
success a -> Bool
cond LocalPackage -> m a
f (Targets [LocalPackage]
targets) =
  (LocalPackage -> m a -> m a) -> m a -> [LocalPackage] -> m a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LocalPackage -> m a -> m a
chain (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
success) [LocalPackage]
targets
  where
    chain :: LocalPackage -> m a -> m a
chain LocalPackage
a m a
z = do
      a
res <- LocalPackage -> m a
f LocalPackage
a
      if a -> Bool
cond a
res
      then a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
      else m a
z

allMTargets ::
  Monad m =>
  (LocalPackage -> m Bool) ->
  Targets ->
  m Bool
allMTargets :: forall (m :: * -> *).
Monad m =>
(LocalPackage -> m Bool) -> Targets -> m Bool
allMTargets LocalPackage -> m Bool
f (Targets [LocalPackage]
targets) =
  (LocalPackage -> m Bool) -> [LocalPackage] -> m Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
allM LocalPackage -> m Bool
f [LocalPackage]
targets

overTargets :: Targets -> (a -> a) -> Packages a -> Packages a
overTargets :: forall a. Targets -> (a -> a) -> Packages a -> Packages a
overTargets (Targets -> Set LocalPackage
targetsSet -> Set LocalPackage
targets) a -> a
f =
  (LocalPackage -> a -> a) -> Packages a -> Packages a
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(k -> v1 -> v2) -> map1 -> map2
nMapWithKey LocalPackage -> a -> a
checked
  where
    checked :: LocalPackage -> a -> a
checked LocalPackage
package a
a
      | LocalPackage -> Set LocalPackage -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member LocalPackage
package Set LocalPackage
targets
      = a -> a
f a
a
      | Bool
otherwise
      = a
a