{-# 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
#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
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 ::
MonadIO m =>
Config ->
[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)