{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Nix.Graph.Internal where

import Algebra.Graph.AdjacencyMap (AdjacencyMap)
import Control.Applicative ((<|>))
import Control.Concurrent.STM.TSem (TSem)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Attoparsec.Text ((<?>))
import Data.Hashable (Hashable)
import Data.Set (Set)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import System.Exit (ExitCode (..))

import qualified Algebra.Graph.AdjacencyMap as AdjacencyMap
import qualified Control.Concurrent.STM.Map as STM.Map
import qualified Control.Concurrent.STM.TSem as TSem
import qualified Data.Attoparsec.Text as Attoparsec
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Nix.Derivation
import qualified UnliftIO.Async as Async
import qualified UnliftIO.Directory as Directory
import qualified UnliftIO.Exception as Exception
import qualified UnliftIO.IO as IO
import qualified UnliftIO.Process as Process
import qualified UnliftIO.STM as STM

-- Support `MonadFail` on GHC 8.6.5
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail (MonadFail)
#endif
#if MIN_VERSION_base(4,13,0)
import Prelude hiding (MonadFail)
#endif

data Derivation = Derivation
  { Derivation -> FilePath
derivationPath :: FilePath
  , Derivation -> [FilePath]
derivationInputDrvs :: [FilePath]
  , Derivation -> Bool
derivationBuilt :: Bool
  }
  deriving stock (Derivation -> Derivation -> Bool
(Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Bool) -> Eq Derivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Derivation -> Derivation -> Bool
$c/= :: Derivation -> Derivation -> Bool
== :: Derivation -> Derivation -> Bool
$c== :: Derivation -> Derivation -> Bool
Eq, Eq Derivation
Eq Derivation
-> (Derivation -> Derivation -> Ordering)
-> (Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Derivation)
-> (Derivation -> Derivation -> Derivation)
-> Ord Derivation
Derivation -> Derivation -> Bool
Derivation -> Derivation -> Ordering
Derivation -> Derivation -> Derivation
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
min :: Derivation -> Derivation -> Derivation
$cmin :: Derivation -> Derivation -> Derivation
max :: Derivation -> Derivation -> Derivation
$cmax :: Derivation -> Derivation -> Derivation
>= :: Derivation -> Derivation -> Bool
$c>= :: Derivation -> Derivation -> Bool
> :: Derivation -> Derivation -> Bool
$c> :: Derivation -> Derivation -> Bool
<= :: Derivation -> Derivation -> Bool
$c<= :: Derivation -> Derivation -> Bool
< :: Derivation -> Derivation -> Bool
$c< :: Derivation -> Derivation -> Bool
compare :: Derivation -> Derivation -> Ordering
$ccompare :: Derivation -> Derivation -> Ordering
$cp1Ord :: Eq Derivation
Ord, (forall x. Derivation -> Rep Derivation x)
-> (forall x. Rep Derivation x -> Derivation) -> Generic Derivation
forall x. Rep Derivation x -> Derivation
forall x. Derivation -> Rep Derivation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Derivation x -> Derivation
$cfrom :: forall x. Derivation -> Rep Derivation x
Generic)
  deriving anyclass (Int -> Derivation -> Int
Derivation -> Int
(Int -> Derivation -> Int)
-> (Derivation -> Int) -> Hashable Derivation
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Derivation -> Int
$chash :: Derivation -> Int
hashWithSalt :: Int -> Derivation -> Int
$chashWithSalt :: Int -> Derivation -> Int
Hashable)

readDerivation :: (MonadIO m, MonadFail m) => TSem -> FilePath -> m Derivation
readDerivation :: TSem -> FilePath -> m Derivation
readDerivation TSem
tSem FilePath
derivationPath = do
  let acquire :: IO ()
acquire = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TSem -> STM ()
TSem.waitTSem TSem
tSem
  let release :: IO ()
release = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TSem -> STM ()
TSem.signalTSem TSem
tSem

  Derivation FilePath Text
drv <- IO (Derivation FilePath Text) -> m (Derivation FilePath Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Derivation FilePath Text) -> m (Derivation FilePath Text))
-> (IO (Derivation FilePath Text) -> IO (Derivation FilePath Text))
-> IO (Derivation FilePath Text)
-> m (Derivation FilePath Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ()
-> IO ()
-> IO (Derivation FilePath Text)
-> IO (Derivation FilePath Text)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
Exception.bracket_ IO ()
acquire IO ()
release (IO (Derivation FilePath Text) -> m (Derivation FilePath Text))
-> IO (Derivation FilePath Text) -> m (Derivation FilePath Text)
forall a b. (a -> b) -> a -> b
$
    FilePath
-> IOMode
-> (Handle -> IO (Derivation FilePath Text))
-> IO (Derivation FilePath Text)
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
IO.withFile FilePath
derivationPath IOMode
IO.ReadMode ((Handle -> IO (Derivation FilePath Text))
 -> IO (Derivation FilePath Text))
-> (Handle -> IO (Derivation FilePath Text))
-> IO (Derivation FilePath Text)
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
      Text
fileContents <- Handle -> IO Text
Text.IO.hGetContents Handle
handle
      case Parser (Derivation FilePath Text)
-> Text -> Either FilePath (Derivation FilePath Text)
forall a. Parser a -> Text -> Either FilePath a
Attoparsec.parseOnly Parser (Derivation FilePath Text)
Nix.Derivation.parseDerivation Text
fileContents of
        Left FilePath
err -> FilePath -> IO (Derivation FilePath Text)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to parse derivation: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err)
        Right Derivation FilePath Text
drv -> Derivation FilePath Text -> IO (Derivation FilePath Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Derivation FilePath Text
drv

  FilePath
outputPath <-
    case Text
-> Map Text (DerivationOutput FilePath Text)
-> Maybe (DerivationOutput FilePath Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"out" (Derivation FilePath Text
-> Map Text (DerivationOutput FilePath Text)
forall fp txt.
Derivation fp txt -> Map txt (DerivationOutput fp txt)
Nix.Derivation.outputs Derivation FilePath Text
drv) of
      Maybe (DerivationOutput FilePath Text)
Nothing -> FilePath -> m FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Failed to lookup output path"
      Just DerivationOutput FilePath Text
output -> FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivationOutput FilePath Text -> FilePath
forall fp txt. DerivationOutput fp txt -> fp
Nix.Derivation.path DerivationOutput FilePath Text
output)

  Bool
derivationBuilt <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
Directory.doesPathExist FilePath
outputPath

  let derivationInputDrvs :: [FilePath]
derivationInputDrvs = Map FilePath (Set Text) -> [FilePath]
forall k a. Map k a -> [k]
Map.keys (Derivation FilePath Text -> Map FilePath (Set Text)
forall fp txt. Derivation fp txt -> Map fp (Set txt)
Nix.Derivation.inputDrvs Derivation FilePath Text
drv)

  Derivation -> m Derivation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Derivation :: FilePath -> [FilePath] -> Bool -> Derivation
Derivation{FilePath
derivationPath :: FilePath
derivationPath :: FilePath
derivationPath, Bool
derivationBuilt :: Bool
derivationBuilt :: Bool
derivationBuilt, [FilePath]
derivationInputDrvs :: [FilePath]
derivationInputDrvs :: [FilePath]
derivationInputDrvs}

buildAdjacencyMap ::
  MonadIO m =>
  Eq k =>
  Hashable k =>
  (k -> IO (Set k)) ->
  [k] ->
  m [(k, Set k)]
buildAdjacencyMap :: (k -> IO (Set k)) -> [k] -> m [(k, Set k)]
buildAdjacencyMap k -> IO (Set k)
getNeighbors [k]
roots = IO [(k, Set k)] -> m [(k, Set k)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(k, Set k)] -> m [(k, Set k)])
-> IO [(k, Set k)] -> m [(k, Set k)]
forall a b. (a -> b) -> a -> b
$ do
  Map k (Set k)
stmMap <- STM (Map k (Set k)) -> IO (Map k (Set k))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically STM (Map k (Set k))
forall k v. STM (Map k v)
STM.Map.empty

  let go :: k -> IO ()
go k
key = do
        Bool
isMember <- STM Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
          Bool
isMember <- k -> Map k (Set k) -> STM Bool
forall k v. (Eq k, Hashable k) => k -> Map k v -> STM Bool
STM.Map.member k
key Map k (Set k)
stmMap
          Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMember (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ k -> Set k -> Map k (Set k) -> STM ()
forall k v. (Eq k, Hashable k) => k -> v -> Map k v -> STM ()
STM.Map.insert k
key Set k
forall a. Set a
Set.empty Map k (Set k)
stmMap
          Bool -> STM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
isMember
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMember (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Set k
neighbors <- k -> IO (Set k)
getNeighbors k
key
          STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ k -> Set k -> Map k (Set k) -> STM ()
forall k v. (Eq k, Hashable k) => k -> v -> Map k v -> STM ()
STM.Map.insert k
key Set k
neighbors Map k (Set k)
stmMap
          (k -> IO ()) -> Set k -> IO ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
Async.mapConcurrently_ k -> IO ()
go Set k
neighbors

  (k -> IO ()) -> [k] -> IO ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
Async.mapConcurrently_ k -> IO ()
go [k]
roots

  Map k (Set k) -> IO [(k, Set k)]
forall k v. Map k v -> IO [(k, v)]
STM.Map.unsafeToList Map k (Set k)
stmMap

filterUnbuilt :: (MonadIO m, MonadFail m) => [FilePath] -> m (Set FilePath)
filterUnbuilt :: [FilePath] -> m (Set FilePath)
filterUnbuilt [FilePath]
derivationPaths = do
  (ExitCode
exitCode, FilePath
_nixStdOut, FilePath
nixStdErr) <-
    FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
Process.readProcessWithExitCode
      FilePath
"nix-store"
      ( [ FilePath
"--realize"
        , FilePath
"--dry-run"
        ]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
derivationPaths
      )
      FilePath
""

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> m ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to run 'nix-store --realize --dry-run " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords [FilePath]
derivationPaths FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"':\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
nixStdErr)

  case Parser [FilePath] -> Text -> Either FilePath [FilePath]
forall a. Parser a -> Text -> Either FilePath a
Attoparsec.parseOnly Parser [FilePath]
willBeBuilt (FilePath -> Text
Text.pack FilePath
nixStdErr) of
    Left FilePath
parseError ->
      FilePath -> m (Set FilePath)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Failed to parse output from 'nix-store --realize --dry-run ...':\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
parseError)
    Right [FilePath]
derivationPathsToBuild -> do
      Set FilePath -> m (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
derivationPathsToBuild)
  where
    willBeBuilt :: Attoparsec.Parser [FilePath]
    willBeBuilt :: Parser [FilePath]
willBeBuilt = [FilePath] -> Parser [FilePath] -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
Attoparsec.option [] (Parser [FilePath] -> Parser [FilePath])
-> Parser [FilePath] -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ do
      Parser ()
willBeBuiltHeading
      Parser Text FilePath -> Parser [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Attoparsec.many' Parser Text FilePath
nixStorePath

    -- Slightly different headings depending on Nix version
    --
    -- Nix 2: https://github.com/NixOS/nix/blob/2.3.10/src/libmain/shared.cc#L45-L71
    -- (uses the same strings from Nix 2.0 to 2.3.10)

    --
    -- Nix 3: https://github.com/NixOS/nix/blob/8e758d4/src/libmain/shared.cc#L48-L86
    -- (latest as of 2020-02-25)

    willBeBuiltHeading :: Attoparsec.Parser ()
    willBeBuiltHeading :: Parser ()
willBeBuiltHeading = do
      let nix2 :: Parser Text Text
nix2 = Parser Text Text
"these derivations will be built:"
      let nix3 :: Parser Text Text
nix3 =
            Parser Text Text
"this derivation will be built:"
              Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
"these " Parser Text Text -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Integral Int => Parser Text Int
forall a. Integral a => Parser a
Attoparsec.decimal @Int Parser Text Int -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
" derivations will be built:")
      Text
_ <- Parser Text Text
nix2 Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
nix3
      Parser ()
Attoparsec.endOfLine

    nixStorePath :: Attoparsec.Parser FilePath
    nixStorePath :: Parser Text FilePath
nixStorePath = (Parser Text FilePath -> FilePath -> Parser Text FilePath
forall i a. Parser i a -> FilePath -> Parser i a
<?> FilePath
"/nix/store path") (Parser Text FilePath -> Parser Text FilePath)
-> Parser Text FilePath -> Parser Text FilePath
forall a b. (a -> b) -> a -> b
$ do
      Text
_ <- Parser Text Text
"  "
      Text
nixStore <- Parser Text Text
"/nix/store"
      Text
rest <- (Char -> Bool) -> Parser Text Text
Attoparsec.takeTill Char -> Bool
Attoparsec.isEndOfLine
      Parser ()
Attoparsec.endOfLine
      FilePath -> Parser Text FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FilePath
Text.unpack (Text
nixStore Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest))

data Config = Config
  { Config -> Exclude
exclude :: Exclude
  , Config -> Natural
maxFiles :: Natural
  }

data Exclude
  = ExcludeNothing
  | ExcludeBuilt
  | ExcludeCached
  deriving stock (Exclude -> Exclude -> Bool
(Exclude -> Exclude -> Bool)
-> (Exclude -> Exclude -> Bool) -> Eq Exclude
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exclude -> Exclude -> Bool
$c/= :: Exclude -> Exclude -> Bool
== :: Exclude -> Exclude -> Bool
$c== :: Exclude -> Exclude -> Bool
Eq)

-- | Build graph of dependencies
build ::
  MonadIO m =>
  -- | Configure how the graph is built
  Config ->
  -- | Derivations to build graph from
  [FilePath] ->
  m (AdjacencyMap FilePath)
build :: Config -> [FilePath] -> m (AdjacencyMap FilePath)
build Config
_ [] = AdjacencyMap FilePath -> m (AdjacencyMap FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AdjacencyMap FilePath
forall a. AdjacencyMap a
AdjacencyMap.empty)
build Config{Exclude
exclude :: Exclude
exclude :: Config -> Exclude
exclude, Natural
maxFiles :: Natural
maxFiles :: Config -> Natural
maxFiles} [FilePath]
roots = IO (AdjacencyMap FilePath) -> m (AdjacencyMap FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AdjacencyMap FilePath) -> m (AdjacencyMap FilePath))
-> IO (AdjacencyMap FilePath) -> m (AdjacencyMap FilePath)
forall a b. (a -> b) -> a -> b
$ do
  TSem
tSem <- STM TSem -> IO TSem
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM TSem -> IO TSem) -> STM TSem -> IO TSem
forall a b. (a -> b) -> a -> b
$ Integer -> STM TSem
TSem.newTSem (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
maxFiles)

  [FilePath] -> IO [Derivation]
process :: [FilePath] -> IO [Derivation] <- do
    case Exclude
exclude of
      Exclude
ExcludeCached -> do
        Set FilePath
unbuiltSet <- [FilePath] -> IO (Set FilePath)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
[FilePath] -> m (Set FilePath)
filterUnbuilt [FilePath]
roots

        ([FilePath] -> IO [Derivation])
-> IO ([FilePath] -> IO [Derivation])
forall (f :: * -> *) a. Applicative f => a -> f a
pure \[FilePath]
paths -> do
          let unbuiltPaths :: [FilePath]
unbuiltPaths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
unbuiltSet) [FilePath]
paths

          (FilePath -> IO Derivation) -> [FilePath] -> IO [Derivation]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
Async.mapConcurrently (TSem -> FilePath -> IO Derivation
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
TSem -> FilePath -> m Derivation
readDerivation TSem
tSem) [FilePath]
unbuiltPaths
      Exclude
ExcludeBuilt -> do
        ([FilePath] -> IO [Derivation])
-> IO ([FilePath] -> IO [Derivation])
forall (f :: * -> *) a. Applicative f => a -> f a
pure \[FilePath]
paths -> do
          [Derivation]
derivations <- (FilePath -> IO Derivation) -> [FilePath] -> IO [Derivation]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
Async.mapConcurrently (TSem -> FilePath -> IO Derivation
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
TSem -> FilePath -> m Derivation
readDerivation TSem
tSem) [FilePath]
paths

          [Derivation] -> IO [Derivation]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Derivation -> Bool) -> [Derivation] -> [Derivation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Derivation -> Bool) -> Derivation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derivation -> Bool
derivationBuilt) [Derivation]
derivations)
      Exclude
ExcludeNothing -> do
        ([FilePath] -> IO [Derivation])
-> IO ([FilePath] -> IO [Derivation])
forall (f :: * -> *) a. Applicative f => a -> f a
pure \[FilePath]
paths -> do
          (FilePath -> IO Derivation) -> [FilePath] -> IO [Derivation]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
Async.mapConcurrently (TSem -> FilePath -> IO Derivation
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
TSem -> FilePath -> m Derivation
readDerivation TSem
tSem) [FilePath]
paths

  let getInputDrvs :: Derivation -> IO (Set Derivation)
      getInputDrvs :: Derivation -> IO (Set Derivation)
getInputDrvs Derivation
derivation = do
        ([Derivation] -> Set Derivation)
-> IO [Derivation] -> IO (Set Derivation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Derivation] -> Set Derivation
forall a. Ord a => [a] -> Set a
Set.fromList ([FilePath] -> IO [Derivation]
process (Derivation -> [FilePath]
derivationInputDrvs Derivation
derivation))

  [Derivation]
rootDrvs <- [FilePath] -> IO [Derivation]
process [FilePath]
roots

  [(Derivation, Set Derivation)]
adjacencySets <- (Derivation -> IO (Set Derivation))
-> [Derivation] -> IO [(Derivation, Set Derivation)]
forall (m :: * -> *) k.
(MonadIO m, Eq k, Hashable k) =>
(k -> IO (Set k)) -> [k] -> m [(k, Set k)]
buildAdjacencyMap Derivation -> IO (Set Derivation)
getInputDrvs [Derivation]
rootDrvs

  let adjacencyMap :: AdjacencyMap Derivation
adjacencyMap = [(Derivation, Set Derivation)] -> AdjacencyMap Derivation
forall a. Ord a => [(a, Set a)] -> AdjacencyMap a
AdjacencyMap.fromAdjacencySets [(Derivation, Set Derivation)]
adjacencySets

  AdjacencyMap FilePath -> IO (AdjacencyMap FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Derivation -> FilePath)
-> AdjacencyMap Derivation -> AdjacencyMap FilePath
forall a b.
(Ord a, Ord b) =>
(a -> b) -> AdjacencyMap a -> AdjacencyMap b
AdjacencyMap.gmap Derivation -> FilePath
derivationPath AdjacencyMap Derivation
adjacencyMap)