Targets.hs

module Hix.Managed.Data.Targets (
  Targets (Targets),
  unsafeTargets,
  getTargets,
  targetsSet,
  singleTarget,
  sortTargets,
  allMTargets,
  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 (Eq, Show, Generic)
  deriving newtype (IsString, Ord, FromJSON, FromJSONKey, Pretty, EncodeNixKey)

newtype Targets =
  UnsafeTargets [LocalPackage]
  deriving stock (Eq, Show)

pattern Targets :: [LocalPackage] -> Targets
pattern Targets pkgs <- UnsafeTargets pkgs

{-# complete Targets #-}

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

singleTarget :: LocalPackage -> Targets
singleTarget = UnsafeTargets . pure

instance IsString Targets where
  fromString = singleTarget . fromString

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

targetsSet :: Targets -> Set LocalPackage
targetsSet (Targets targets) =
  Set.fromList targets

graph ::
  Map LocalPackage [LocalPackage] ->
  (Graph, Vertex -> (LocalPackage, LocalPackage, [LocalPackage]), LocalPackage -> Maybe Vertex)
graph deps =
  graphFromEdges keyAssoc
  where
    keyAssoc = Map.toList deps <&> \ (p, ds) -> (p, p, ds)

onlyFrom :: Set LocalPackage -> [LocalPackage] -> [LocalPackage]
onlyFrom targets deps =
  mapMaybe isTarget deps
  where
    isTarget = \case
      dep | Set.member dep targets -> Just dep
      _ -> Nothing

sortTargets ::
  Packages [LocalPackage] ->
  [LocalPackage] ->
  Targets
sortTargets deps targets =
  UnsafeTargets (reverseTopSort g <&> \ v -> let (n, _, _) = get v in n)
  where
    (g, get, _) = graph (nGet simple)
    simple :: Packages [LocalPackage]
    simple = nMap (onlyFrom targetSet) (nRestrictKeys targetSet deps)
    targetSet = Set.fromList targets

allMTargets ::
  Monad m =>
  (LocalPackage -> m Bool) ->
  Targets ->
  m Bool
allMTargets f (Targets targets) =
  allM f targets

overTargets :: Targets -> (a -> a) -> Packages a -> Packages a
overTargets (targetsSet -> targets) f =
  nMapWithKey checked
  where
    checked package a
      | Set.member package targets
      = f a
      | otherwise
      = a