{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeFamilies #-}

module Hercules.Agent.NixFile
  ( -- * Schemas
    HomeSchema,
    HerculesCISchema,
    OnPushSchema,
    OnScheduleSchema,
    ExtraInputsSchema,
    InputDeclSchema,
    InputsSchema,
    InputSchema,
    OutputsSchema,
    TimeConstraintsSchema,

    -- * Loading
    findNixFile,
    loadNixFile,
    HomeExpr (..),
    homeExprRawValue,
    getHerculesCI,
    loadDefaultHerculesCI,

    -- * @onPush@
    getVirtualValueByPath,
    parseExtraInputs,
  )
where

import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Map qualified as M
import Data.Type.Equality (type (~))
import Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration (InputDeclaration (SiblingInput), SiblingInput (MkSiblingInput))
import Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration qualified
import Hercules.Agent.NixFile.CiNixArgs (CiNixArgs (CiNixArgs))
import Hercules.Agent.NixFile.CiNixArgs qualified
import Hercules.Agent.NixFile.GitSource (GitSource)
import Hercules.Agent.NixFile.HerculesCIArgs (HerculesCIArgs)
import Hercules.Agent.NixFile.HerculesCIArgs qualified as HerculesCIArgs
import Hercules.CNix.Expr
  ( EvalState,
    Match (IsAttrs),
    NixAttrs,
    Value (Value, rtValue),
    addAllowedPath,
    assertType,
    autoCallFunction,
    evalFile,
    getAttr,
    getFlakeFromFlakeRef,
    getLocalFlake,
    match',
    toRawValue,
    unsafeAssertType,
    valueFromExpressionString,
  )
import Hercules.CNix.Expr.Raw (RawValue)
import Hercules.CNix.Expr.Schema (Attrs, Dictionary, MonadEval, PSObject (PSObject), Provenance (Other), StringWithoutContext, basicAttrsWithProvenance, dictionaryToMap, fromPSObject, toPSObject, (#.), (#?), ($?), (.$), (>>$.), type (->.), type (->?), type (.), type (::.), type (::?), type (::??), type (?), type (|.))
import Hercules.CNix.Expr.Schema qualified as Schema
import Hercules.Error (escalateAs)
import Paths_hercules_ci_agent (getDataFileName)
import Protolude hiding (evalState)
import System.Directory qualified as Dir
import System.FilePath (takeDirectory, takeFileName, (</>))
import UnliftIO.Directory (doesPathExist)

type Ambiguity = [FilePath]

searchPath :: [Ambiguity]
searchPath :: [Ambiguity]
searchPath = [[FilePath
"nix/ci.nix", FilePath
"ci.nix"], [FilePath
"flake.nix"], [FilePath
"default.nix"]]

findNixFile :: FilePath -> IO (Either Text FilePath)
findNixFile :: FilePath -> IO (Either Text FilePath)
findNixFile FilePath
projectDir = do
  [[Maybe (FilePath, FilePath)]]
searchResult <-
    [Ambiguity]
-> (Ambiguity -> IO [Maybe (FilePath, FilePath)])
-> IO [[Maybe (FilePath, FilePath)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Ambiguity]
searchPath ((Ambiguity -> IO [Maybe (FilePath, FilePath)])
 -> IO [[Maybe (FilePath, FilePath)]])
-> (Ambiguity -> IO [Maybe (FilePath, FilePath)])
-> IO [[Maybe (FilePath, FilePath)]]
forall a b. (a -> b) -> a -> b
$
      (FilePath -> IO (Maybe (FilePath, FilePath)))
-> Ambiguity -> IO [Maybe (FilePath, FilePath)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((FilePath -> IO (Maybe (FilePath, FilePath)))
 -> Ambiguity -> IO [Maybe (FilePath, FilePath)])
-> (FilePath -> IO (Maybe (FilePath, FilePath)))
-> Ambiguity
-> IO [Maybe (FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ \FilePath
relPath ->
        let path :: FilePath
path = FilePath
projectDir FilePath -> FilePath -> FilePath
</> FilePath
relPath
         in FilePath -> IO Bool
Dir.doesFileExist FilePath
path IO Bool
-> (Bool -> IO (Maybe (FilePath, FilePath)))
-> IO (Maybe (FilePath, FilePath))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Bool
True -> Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath)))
-> Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just (FilePath
relPath, FilePath
path)
              Bool
False -> Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing
  Either Text FilePath -> IO (Either Text FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text FilePath -> IO (Either Text FilePath))
-> Either Text FilePath -> IO (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ case ([(FilePath, FilePath)] -> Bool)
-> [[(FilePath, FilePath)]] -> [[(FilePath, FilePath)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([(FilePath, FilePath)] -> Bool)
-> [(FilePath, FilePath)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, FilePath)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[(FilePath, FilePath)]] -> [[(FilePath, FilePath)]])
-> [[(FilePath, FilePath)]] -> [[(FilePath, FilePath)]]
forall a b. (a -> b) -> a -> b
$ ([Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [[Maybe (FilePath, FilePath)]] -> [[(FilePath, FilePath)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes [[Maybe (FilePath, FilePath)]]
searchResult of
    [(FilePath
_relPath, FilePath
unambiguous)] : [[(FilePath, FilePath)]]
_ -> FilePath -> Either Text FilePath
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
unambiguous
    [(FilePath, FilePath)]
ambiguous : [[(FilePath, FilePath)]]
_ ->
      Text -> Either Text FilePath
forall a b. a -> Either a b
Left (Text -> Either Text FilePath) -> Text -> Either Text FilePath
forall a b. (a -> b) -> a -> b
$
        Text
"Don't know what to do, expecting only one of "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Schema.englishOr (((FilePath, FilePath) -> Text) -> [(FilePath, FilePath)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> Text)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, FilePath)]
ambiguous)
    [] ->
      Text -> Either Text FilePath
forall a b. a -> Either a b
Left (Text -> Either Text FilePath) -> Text -> Either Text FilePath
forall a b. (a -> b) -> a -> b
$
        Text
"Please provide a Nix expression to build. Could not find any of "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Schema.englishOr ((Ambiguity -> [Text]) -> [Ambiguity] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((FilePath -> Text) -> Ambiguity -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map FilePath -> Text
forall a b. ConvertText a b => a -> b
toS) [Ambiguity]
searchPath)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in your source"

-- | Expression containing the bulk of the project
data HomeExpr
  = Flake (Value NixAttrs)
  | CiNix FilePath RawValue

homeExprRawValue :: HomeExpr -> RawValue
homeExprRawValue :: HomeExpr -> RawValue
homeExprRawValue (Flake (Value RawValue
r)) = RawValue
r
homeExprRawValue (CiNix FilePath
_ RawValue
r) = RawValue
r

loadNixFile :: Ptr EvalState -> FilePath -> GitSource -> IO (Either Text HomeExpr)
loadNixFile :: Ptr EvalState -> FilePath -> GitSource -> IO (Either Text HomeExpr)
loadNixFile Ptr EvalState
evalState FilePath
projectPath GitSource
src = ExceptT Text IO HomeExpr -> IO (Either Text HomeExpr)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  FilePath
nixFile <- IO (Either Text FilePath) -> ExceptT Text IO FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text FilePath) -> ExceptT Text IO FilePath)
-> IO (Either Text FilePath) -> ExceptT Text IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either Text FilePath)
findNixFile FilePath
projectPath
  if FilePath -> FilePath
takeFileName FilePath
nixFile FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"flake.nix"
    then do
      -- NB This branch of logic is not used by hercules-ci-agent, which fetches
      --    directly from flakeref and does not go through a local path.
      --    An actual consumer of this branch is the hci CLI.

      -- TODO: Can Nix decide isGit (and more) for us?
      Bool
isGit <- FilePath -> ExceptT Text IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesPathExist (FilePath -> FilePath
takeDirectory FilePath
nixFile FilePath -> FilePath -> FilePath
</> FilePath
".git")
      Value NixAttrs
val <-
        IO RawValue -> ExceptT Text IO RawValue
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
          ( if Bool
isGit
              then Ptr EvalState -> ByteString -> IO RawValue
getFlakeFromFlakeRef Ptr EvalState
evalState (ByteString
"git+file://" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
projectPath))
              else Ptr EvalState -> Text -> IO RawValue
getLocalFlake Ptr EvalState
evalState (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
projectPath)
          )
          ExceptT Text IO RawValue
-> (RawValue -> ExceptT Text IO (Value NixAttrs))
-> ExceptT Text IO (Value NixAttrs)
forall a b.
ExceptT Text IO a -> (a -> ExceptT Text IO b) -> ExceptT Text IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr EvalState -> RawValue -> ExceptT Text IO (Value NixAttrs)
forall (m :: * -> *) t.
(HasCallStack, MonadIO m, CheckType t) =>
Ptr EvalState -> RawValue -> m (Value t)
assertType Ptr EvalState
evalState
      HomeExpr -> ExceptT Text IO HomeExpr
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value NixAttrs -> HomeExpr
Flake Value NixAttrs
val)
    else do
      RawValue
rootValueOrFunction <- IO RawValue -> ExceptT Text IO RawValue
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> ExceptT Text IO RawValue)
-> IO RawValue -> ExceptT Text IO RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> FilePath -> IO RawValue
evalFile Ptr EvalState
evalState FilePath
nixFile
      Value NixAttrs
args <- forall a. RawValue -> Value a
unsafeAssertType @NixAttrs (RawValue -> Value NixAttrs)
-> ExceptT Text IO RawValue -> ExceptT Text IO (Value NixAttrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RawValue -> ExceptT Text IO RawValue
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState -> CiNixArgs -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState CiNixArgs {src :: GitSource
src = GitSource
src})
      RawValue
homeExpr <- IO RawValue -> ExceptT Text IO RawValue
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> ExceptT Text IO RawValue)
-> IO RawValue -> ExceptT Text IO RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> RawValue -> Value NixAttrs -> IO RawValue
autoCallFunction Ptr EvalState
evalState RawValue
rootValueOrFunction Value NixAttrs
args
      HomeExpr -> ExceptT Text IO HomeExpr
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> RawValue -> HomeExpr
CiNix FilePath
nixFile RawValue
homeExpr)

getHomeExprObject :: (MonadEval m) => HomeExpr -> m (PSObject HomeSchema)
getHomeExprObject :: forall (m :: * -> *).
MonadEval m =>
HomeExpr -> m (PSObject HomeSchema)
getHomeExprObject (Flake Value NixAttrs
attrs) = PSObject HomeSchema -> m (PSObject HomeSchema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject {value :: RawValue
value = Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
attrs, provenance :: Provenance
provenance = FilePath -> Provenance
Schema.File FilePath
"flake.nix"}
getHomeExprObject (CiNix FilePath
f RawValue
obj) = PSObject HomeSchema -> m (PSObject HomeSchema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject {value :: RawValue
value = RawValue
obj, provenance :: Provenance
provenance = FilePath -> Provenance
Schema.File FilePath
f}

type HomeSchema = Attrs '["herculesCI" ::? Attrs '[] ->? HerculesCISchema]

type HerculesCISchema =
  Attrs
    '[ "onPush" ::? Dictionary OnPushSchema,
       "onSchedule" ::? Dictionary OnScheduleSchema
     ]

type OnPushSchema =
  Attrs
    '[ "extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction,
       "enable" ::? Bool
     ]

type OutputsFunction = InputsSchema ->? OutputsSchema

type ExtraInputsSchema = Dictionary InputDeclSchema

type InputDeclSchema =
  Attrs
    '[ "project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext
     ]

type OnScheduleSchema =
  Attrs
    '[ "extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction,
       "enable" ::? Bool,
       "when" ::?? TimeConstraintsSchema
     ]

type TimeConstraintsSchema =
  Attrs
    '[ "hour" ::?? HoursSchema,
       "minute" ::?? MinuteSchema,
       "dayOfWeek" ::?? DaysOfWeekSchema,
       "dayOfMonth" ::?? DaysOfMonthSchema
     ]

type HoursSchema = Int64 |. [Int64]

type MinuteSchema = Int64

type DaysOfWeekSchema = [StringWithoutContext]

type DaysOfMonthSchema = [Int64]

type InputsSchema = Dictionary InputSchema

type InputSchema = Dictionary RawValue

type OutputsSchema = Dictionary RawValue

type DefaultHerculesCIHelperSchema =
  Attrs
    '[ "addDefaults" ::. Attrs '[] ->. Attrs '[] ->. HerculesCISchema
     ]

exprString :: forall a m. (MonadEval m) => ByteString -> m (PSObject a)
exprString :: forall a (m :: * -> *). MonadEval m => ByteString -> m (PSObject a)
exprString ByteString
bs = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  RawValue
value <- IO RawValue -> m RawValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> m RawValue) -> IO RawValue -> m RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> ByteString -> ByteString -> IO RawValue
valueFromExpressionString Ptr EvalState
evalState ByteString
bs ByteString
"/var/lib/empty/hercules-ci-agent-builtin"
  PSObject a -> m (PSObject a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject {value :: RawValue
value = RawValue
value, provenance :: Provenance
provenance = Text -> Provenance
Schema.Other Text
"hercules-ci-agent built-in expression"}

getHerculesCI :: (MonadEval m) => HomeExpr -> HerculesCIArgs -> m (Maybe (PSObject HerculesCISchema))
getHerculesCI :: forall (m :: * -> *).
MonadEval m =>
HomeExpr -> HerculesCIArgs -> m (Maybe (PSObject HerculesCISchema))
getHerculesCI HomeExpr
homeExpr HerculesCIArgs
args = do
  PSObject HomeSchema
home <- HomeExpr -> m (PSObject HomeSchema)
forall (m :: * -> *).
MonadEval m =>
HomeExpr -> m (PSObject HomeSchema)
getHomeExprObject HomeExpr
homeExpr
  PSObject (Attrs '[])
args' <- PSObject (NixTypeFor HerculesCIArgs) -> PSObject (Attrs '[])
forall a b. PSObject a -> PSObject b
Schema.uncheckedCast (PSObject (NixTypeFor HerculesCIArgs) -> PSObject (Attrs '[]))
-> m (PSObject (NixTypeFor HerculesCIArgs))
-> m (PSObject (Attrs '[]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HerculesCIArgs -> m (PSObject (NixTypeFor HerculesCIArgs))
forall (m :: * -> *) a.
(MonadEval m, ToRawValue a) =>
a -> m (PSObject (NixTypeFor a))
toPSObject HerculesCIArgs
args
  case HomeExpr
homeExpr of
    CiNix {} ->
      PSObject HomeSchema
home
        #? #herculesCI
        m (Maybe
     (PSObject ((Attrs '[] ->. HerculesCISchema) |. HerculesCISchema)))
-> (Maybe
      (PSObject ((Attrs '[] ->. HerculesCISchema) |. HerculesCISchema))
    -> m (Maybe (PSObject HerculesCISchema)))
-> m (Maybe (PSObject HerculesCISchema))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @Maybe \PSObject ((Attrs '[] ->. HerculesCISchema) |. HerculesCISchema)
herculesCI ->
          PSObject ((Attrs '[] ->. HerculesCISchema) |. HerculesCISchema)
herculesCI PSObject ((Attrs '[] ->. HerculesCISchema) |. HerculesCISchema)
-> PSObject (Attrs '[]) -> m (PSObject HerculesCISchema)
forall (m :: * -> *) b a.
(MonadEval m, PossibleTypesForSchema b) =>
PSObject (a ->? b) -> PSObject a -> m (PSObject b)
$? PSObject (Attrs '[])
args'
    Flake Value NixAttrs
flake ->
      PSObject HerculesCISchema -> Maybe (PSObject HerculesCISchema)
forall a. a -> Maybe a
Just (PSObject HerculesCISchema -> Maybe (PSObject HerculesCISchema))
-> m (PSObject HerculesCISchema)
-> m (Maybe (PSObject HerculesCISchema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        -- fixup primaryRepo.outPath, which we didn't set to the right value for
        -- flakes earlier, because we don't have a local checkout.
        PSObject (Attrs '[])
args'' <-
          forall a (m :: * -> *). MonadEval m => ByteString -> m (PSObject a)
exprString @(Attrs _ ->. HomeSchema ->. Attrs _)
            ByteString
"args': flake: args' // { primaryRepo = args'.primaryRepo // { outPath = flake.outPath; }; }"
            m (PSObject (Attrs '[] ->. (HomeSchema ->. Attrs '[])))
-> m (PSObject (Attrs '[]))
-> m (PSObject (HomeSchema ->. Attrs '[]))
forall (m :: * -> *) a b.
MonadEval m =>
m (PSObject (a ->. b)) -> m (PSObject a) -> m (PSObject b)
>>$. PSObject (Attrs '[]) -> m (PSObject (Attrs '[]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject (Attrs '[])
args'
            m (PSObject (HomeSchema ->. Attrs '[]))
-> m (PSObject HomeSchema) -> m (PSObject (Attrs '[]))
forall (m :: * -> *) a b.
MonadEval m =>
m (PSObject (a ->. b)) -> m (PSObject a) -> m (PSObject b)
>>$. PSObject HomeSchema -> m (PSObject HomeSchema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject HomeSchema
home

        PSObject DefaultHerculesCIHelperSchema
dh <- m (PSObject DefaultHerculesCIHelperSchema)
forall (m :: * -> *).
MonadEval m =>
m (PSObject DefaultHerculesCIHelperSchema)
loadDefaultHerculesCI
        PSObject (Attrs '[] ->. (Attrs '[] ->. HerculesCISchema))
fn <- PSObject DefaultHerculesCIHelperSchema
dh PSObject DefaultHerculesCIHelperSchema
-> AttrLabel "addDefaults"
-> m (PSObject
        ('["addDefaults"
           ::. (Attrs '[] ->. (Attrs '[] ->. HerculesCISchema))]
         . "addDefaults"))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject (as . s))
#. AttrLabel "addDefaults"
#addDefaults
        let flakeObj :: PSObject (Attrs '[])
flakeObj = Value NixAttrs -> Provenance -> PSObject (Attrs '[])
basicAttrsWithProvenance Value NixAttrs
flake (Provenance -> PSObject (Attrs '[]))
-> Provenance -> PSObject (Attrs '[])
forall a b. (a -> b) -> a -> b
$ Text -> Provenance
Schema.Other Text
"your flake"
        PSObject HerculesCISchema
hci <- PSObject (Attrs '[] ->. (Attrs '[] ->. HerculesCISchema))
fn PSObject (Attrs '[] ->. (Attrs '[] ->. HerculesCISchema))
-> PSObject (Attrs '[])
-> m (PSObject (Attrs '[] ->. HerculesCISchema))
forall (m :: * -> *) a b.
MonadIO m =>
PSObject (a ->. b) -> PSObject a -> m (PSObject b)
.$ PSObject (Attrs '[])
flakeObj m (PSObject (Attrs '[] ->. HerculesCISchema))
-> m (PSObject (Attrs '[])) -> m (PSObject HerculesCISchema)
forall (m :: * -> *) a b.
MonadEval m =>
m (PSObject (a ->. b)) -> m (PSObject a) -> m (PSObject b)
>>$. PSObject (Attrs '[]) -> m (PSObject (Attrs '[]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject (Attrs '[])
args''
        PSObject HerculesCISchema -> m (PSObject HerculesCISchema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject HerculesCISchema
hci {provenance :: Provenance
Schema.provenance = Text -> Provenance
Other Text
"the herculesCI attribute of your flake (after adding defaults)"}

parseExtraInputs :: (MonadEval m) => PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration)
parseExtraInputs :: forall (m :: * -> *).
MonadEval m =>
PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration)
parseExtraInputs PSObject ExtraInputsSchema
eis = PSObject ExtraInputsSchema
-> m (Map ByteString (PSObject InputDeclSchema))
forall (m :: * -> *) w.
MonadEval m =>
PSObject (Dictionary w) -> m (Map ByteString (PSObject w))
dictionaryToMap PSObject ExtraInputsSchema
eis m (Map ByteString (PSObject InputDeclSchema))
-> (Map ByteString (PSObject InputDeclSchema)
    -> m (Map ByteString InputDeclaration))
-> m (Map ByteString InputDeclaration)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PSObject InputDeclSchema -> m InputDeclaration)
-> Map ByteString (PSObject InputDeclSchema)
-> m (Map ByteString InputDeclaration)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map ByteString a -> f (Map ByteString b)
traverse PSObject InputDeclSchema -> m InputDeclaration
forall (m :: * -> *).
MonadEval m =>
PSObject InputDeclSchema -> m InputDeclaration
parseInputDecl

parseInputDecl :: (MonadEval m) => PSObject InputDeclSchema -> m InputDeclaration
parseInputDecl :: forall (m :: * -> *).
MonadEval m =>
PSObject InputDeclSchema -> m InputDeclaration
parseInputDecl PSObject InputDeclSchema
d = do
  Text
project <- PSObject InputDeclSchema
d PSObject InputDeclSchema
-> AttrLabel "project"
-> m (PSObject
        (AttrType'
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           "project"))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject (as . s))
#. AttrLabel "project"
#project m (PSObject
     (AttrType'
        '["project" ::. StringWithoutContext,
          "ref" ::? StringWithoutContext]
        '["project" ::. StringWithoutContext,
          "ref" ::? StringWithoutContext]
        "project"))
-> (PSObject
      (AttrType'
         '["project" ::. StringWithoutContext,
           "ref" ::? StringWithoutContext]
         '["project" ::. StringWithoutContext,
           "ref" ::? StringWithoutContext]
         "project")
    -> m Text)
-> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PSObject
  (AttrType'
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     "project")
-> m Text
forall schema a (m :: * -> *).
(FromPSObject schema a, MonadEval m) =>
PSObject schema -> m a
forall (m :: * -> *).
MonadEval m =>
PSObject
  (AttrType'
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     "project")
-> m Text
fromPSObject
  Maybe Text
ref <- PSObject InputDeclSchema
d PSObject InputDeclSchema
-> AttrLabel "ref"
-> m (Maybe
        (PSObject
           (OptionalAttrType'
              '["project" ::. StringWithoutContext,
                "ref" ::? StringWithoutContext]
              '["project" ::. StringWithoutContext,
                "ref" ::? StringWithoutContext]
              "ref")))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w)
-> AttrLabel s -> m (Maybe (PSObject (as ? s)))
#? AttrLabel "ref"
#ref m (Maybe
     (PSObject
        (OptionalAttrType'
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           "ref")))
-> (Maybe
      (PSObject
         (OptionalAttrType'
            '["project" ::. StringWithoutContext,
              "ref" ::? StringWithoutContext]
            '["project" ::. StringWithoutContext,
              "ref" ::? StringWithoutContext]
            "ref"))
    -> m (Maybe Text))
-> m (Maybe Text)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PSObject
   (OptionalAttrType'
      '["project" ::. StringWithoutContext,
        "ref" ::? StringWithoutContext]
      '["project" ::. StringWithoutContext,
        "ref" ::? StringWithoutContext]
      "ref")
 -> m Text)
-> Maybe
     (PSObject
        (OptionalAttrType'
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           '["project" ::. StringWithoutContext,
             "ref" ::? StringWithoutContext]
           "ref"))
-> m (Maybe Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse PSObject
  (OptionalAttrType'
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     "ref")
-> m Text
forall schema a (m :: * -> *).
(FromPSObject schema a, MonadEval m) =>
PSObject schema -> m a
forall (m :: * -> *).
MonadEval m =>
PSObject
  (OptionalAttrType'
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     '["project" ::. StringWithoutContext,
       "ref" ::? StringWithoutContext]
     "ref")
-> m Text
fromPSObject
  InputDeclaration -> m InputDeclaration
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputDeclaration -> m InputDeclaration)
-> InputDeclaration -> m InputDeclaration
forall a b. (a -> b) -> a -> b
$ SiblingInput -> InputDeclaration
SiblingInput (SiblingInput -> InputDeclaration)
-> SiblingInput -> InputDeclaration
forall a b. (a -> b) -> a -> b
$ MkSiblingInput {project :: Text
project = Text
project, ref :: Maybe Text
ref = Maybe Text
ref}

-- | A function for retrieving values from `herculesCI` and legacy ci.nix.
-- It treats the expression as tree of attribute sets, making the required
-- function applications and context gather implicit.
--
-- For example, given a path, this will return the onPush output or legacy
-- ci.nix value. Oversimplifying:
--
-- @@@
-- e.g.  ["a" "b"]  => ((import file).herculesCI args).onPush.a.outputs.b
--       or falling back to
--       ["a" "b"]  => (import file legacyArgs).a.b
-- @@@
getVirtualValueByPath ::
  Ptr EvalState ->
  FilePath ->
  HerculesCIArgs ->
  -- | Resolve inputs to an attrset of fetched/fetchable stuff
  (Map ByteString InputDeclaration -> IO (Value NixAttrs)) ->
  [ByteString] ->
  IO (Maybe RawValue)
getVirtualValueByPath :: Ptr EvalState
-> FilePath
-> HerculesCIArgs
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> [ByteString]
-> IO (Maybe RawValue)
getVirtualValueByPath Ptr EvalState
evalState FilePath
filePath HerculesCIArgs
args Map ByteString InputDeclaration -> IO (Value NixAttrs)
resolveInputs [ByteString]
attrPath = do
  HomeExpr
homeExpr <- (Text -> FatalError) -> Either Text HomeExpr -> IO HomeExpr
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> FatalError
FatalError (Either Text HomeExpr -> IO HomeExpr)
-> IO (Either Text HomeExpr) -> IO HomeExpr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr EvalState -> FilePath -> GitSource -> IO (Either Text HomeExpr)
loadNixFile Ptr EvalState
evalState FilePath
filePath (HerculesCIArgs -> GitSource
HerculesCIArgs.primaryRepo HerculesCIArgs
args)
  (ReaderT (Ptr EvalState) IO (Maybe RawValue)
 -> Ptr EvalState -> IO (Maybe RawValue))
-> Ptr EvalState
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> IO (Maybe RawValue)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> Ptr EvalState -> IO (Maybe RawValue)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Ptr EvalState
evalState do
    Maybe (PSObject HerculesCISchema)
herculesCI <- HomeExpr
-> HerculesCIArgs
-> ReaderT (Ptr EvalState) IO (Maybe (PSObject HerculesCISchema))
forall (m :: * -> *).
MonadEval m =>
HomeExpr -> HerculesCIArgs -> m (Maybe (PSObject HerculesCISchema))
getHerculesCI HomeExpr
homeExpr HerculesCIArgs
args
    Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe <- Maybe
  (Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool]))))
-> Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe
   (Maybe
      (PSObject
         (Attrs'
            '[]
            (Attrs
               '["extraInputs" ::? ExtraInputsSchema,
                 "outputs" ::. OutputsFunction, "enable" ::? Bool]))))
 -> Maybe
      (PSObject
         (Attrs'
            '[]
            (Attrs
               '["extraInputs" ::? ExtraInputsSchema,
                 "outputs" ::. OutputsFunction, "enable" ::? Bool]))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (Maybe
           (PSObject
              (Attrs'
                 '[]
                 (Attrs
                    '["extraInputs" ::? ExtraInputsSchema,
                      "outputs" ::. OutputsFunction, "enable" ::? Bool])))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs'
              '[]
              (Attrs
                 '["extraInputs" ::? ExtraInputsSchema,
                   "outputs" ::. OutputsFunction, "enable" ::? Bool]))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PSObject HerculesCISchema)
-> (PSObject HerculesCISchema
    -> ReaderT
         (Ptr EvalState)
         IO
         (Maybe
            (PSObject
               (Attrs'
                  '[]
                  (Attrs
                     '["extraInputs" ::? ExtraInputsSchema,
                       "outputs" ::. OutputsFunction, "enable" ::? Bool])))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (Maybe
           (PSObject
              (Attrs'
                 '[]
                 (Attrs
                    '["extraInputs" ::? ExtraInputsSchema,
                      "outputs" ::. OutputsFunction, "enable" ::? Bool])))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (PSObject HerculesCISchema)
herculesCI \PSObject HerculesCISchema
hci -> PSObject HerculesCISchema
hci PSObject HerculesCISchema
-> AttrLabel "onPush"
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           ('["onPush"
              ::? Attrs'
                    '[]
                    (Attrs
                       '["extraInputs" ::? ExtraInputsSchema,
                         "outputs" ::. OutputsFunction, "enable" ::? Bool]),
              "onSchedule"
              ::? Attrs'
                    '[]
                    (Attrs
                       '["extraInputs" ::? ExtraInputsSchema,
                         "outputs" ::. OutputsFunction, "enable" ::? Bool,
                         "when" ::?? TimeConstraintsSchema])]
            ? "onPush")))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w)
-> AttrLabel s -> m (Maybe (PSObject (as ? s)))
#? AttrLabel "onPush"
#onPush
    Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
onScheduleMaybe <- Maybe
  (Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema]))))
-> Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe
   (Maybe
      (PSObject
         (Attrs'
            '[]
            (Attrs
               '["extraInputs" ::? ExtraInputsSchema,
                 "outputs" ::. OutputsFunction, "enable" ::? Bool,
                 "when" ::?? TimeConstraintsSchema]))))
 -> Maybe
      (PSObject
         (Attrs'
            '[]
            (Attrs
               '["extraInputs" ::? ExtraInputsSchema,
                 "outputs" ::. OutputsFunction, "enable" ::? Bool,
                 "when" ::?? TimeConstraintsSchema]))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (Maybe
           (PSObject
              (Attrs'
                 '[]
                 (Attrs
                    '["extraInputs" ::? ExtraInputsSchema,
                      "outputs" ::. OutputsFunction, "enable" ::? Bool,
                      "when" ::?? TimeConstraintsSchema])))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs'
              '[]
              (Attrs
                 '["extraInputs" ::? ExtraInputsSchema,
                   "outputs" ::. OutputsFunction, "enable" ::? Bool,
                   "when" ::?? TimeConstraintsSchema]))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PSObject HerculesCISchema)
-> (PSObject HerculesCISchema
    -> ReaderT
         (Ptr EvalState)
         IO
         (Maybe
            (PSObject
               (Attrs'
                  '[]
                  (Attrs
                     '["extraInputs" ::? ExtraInputsSchema,
                       "outputs" ::. OutputsFunction, "enable" ::? Bool,
                       "when" ::?? TimeConstraintsSchema])))))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (Maybe
           (PSObject
              (Attrs'
                 '[]
                 (Attrs
                    '["extraInputs" ::? ExtraInputsSchema,
                      "outputs" ::. OutputsFunction, "enable" ::? Bool,
                      "when" ::?? TimeConstraintsSchema])))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (PSObject HerculesCISchema)
herculesCI \PSObject HerculesCISchema
hci -> PSObject HerculesCISchema
hci PSObject HerculesCISchema
-> AttrLabel "onSchedule"
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           ('["onPush"
              ::? Attrs'
                    '[]
                    (Attrs
                       '["extraInputs" ::? ExtraInputsSchema,
                         "outputs" ::. OutputsFunction, "enable" ::? Bool]),
              "onSchedule"
              ::? Attrs'
                    '[]
                    (Attrs
                       '["extraInputs" ::? ExtraInputsSchema,
                         "outputs" ::. OutputsFunction, "enable" ::? Bool,
                         "when" ::?? TimeConstraintsSchema])]
            ? "onSchedule")))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w)
-> AttrLabel s -> m (Maybe (PSObject (as ? s)))
#? AttrLabel "onSchedule"
#onSchedule
    let require :: Maybe a -> MaybeT (ReaderT (Ptr EvalState) IO) a
require = ReaderT (Ptr EvalState) IO (Maybe a)
-> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT (Ptr EvalState) IO (Maybe a)
 -> MaybeT (ReaderT (Ptr EvalState) IO) a)
-> (Maybe a -> ReaderT (Ptr EvalState) IO (Maybe a))
-> Maybe a
-> MaybeT (ReaderT (Ptr EvalState) IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> ReaderT (Ptr EvalState) IO (Maybe a)
forall a. a -> ReaderT (Ptr EvalState) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        m2s :: k -> Maybe a -> Map k a
m2s k
k (Just a
a) = k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton k
k a
a
        m2s k
_ Maybe a
Nothing = Map k a
forall a. Monoid a => a
mempty

    MaybeT (ReaderT (Ptr EvalState) IO) RawValue
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      case [ByteString]
attrPath of
        [] | Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> Bool
forall a. Maybe a -> Bool
isJust Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe Bool -> Bool -> Bool
|| Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
-> Bool
forall a. Maybe a -> Bool
isJust Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
onScheduleMaybe -> do
          Maybe RawValue
onPush' <- (PSObject
   (Attrs'
      '[]
      (Attrs
         '["extraInputs" ::? ExtraInputsSchema,
           "outputs" ::. OutputsFunction, "enable" ::? Bool]))
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT (ReaderT (Ptr EvalState) IO) (Maybe RawValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> (PSObject
      (Attrs'
         '[]
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool]))
    -> IO RawValue)
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr EvalState
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState) Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe
          Maybe RawValue
onSchedule' <- (PSObject
   (Attrs'
      '[]
      (Attrs
         '["extraInputs" ::? ExtraInputsSchema,
           "outputs" ::. OutputsFunction, "enable" ::? Bool,
           "when" ::?? TimeConstraintsSchema]))
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> Maybe
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
-> MaybeT (ReaderT (Ptr EvalState) IO) (Maybe RawValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> (PSObject
      (Attrs'
         '[]
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool,
              "when" ::?? TimeConstraintsSchema]))
    -> IO RawValue)
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema]))
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr EvalState
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema]))
-> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState) Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
onScheduleMaybe
          IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> IO RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> Map ByteString RawValue -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState (ByteString -> Maybe RawValue -> Map ByteString RawValue
forall {k} {a}. Ord k => k -> Maybe a -> Map k a
m2s (ByteString
"onPush" :: ByteString) Maybe RawValue
onPush' Map ByteString RawValue
-> Map ByteString RawValue -> Map ByteString RawValue
forall a. Semigroup a => a -> a -> a
<> ByteString -> Maybe RawValue -> Map ByteString RawValue
forall {k} {a}. Ord k => k -> Maybe a -> Map k a
m2s ByteString
"onSchedule" Maybe RawValue
onSchedule')
        ByteString
"onPush" : [] -> do
          PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> RawValue
forall a. PSObject a -> RawValue
Schema.value (PSObject
   (Attrs'
      '[]
      (Attrs
         '["extraInputs" ::? ExtraInputsSchema,
           "outputs" ::. OutputsFunction, "enable" ::? Bool]))
 -> RawValue)
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
forall {a}. Maybe a -> MaybeT (ReaderT (Ptr EvalState) IO) a
require Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe
        ByteString
"onPush" : ByteString
jobName : [ByteString]
attrPath' -> do
          PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
onPush <- Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
forall {a}. Maybe a -> MaybeT (ReaderT (Ptr EvalState) IO) a
require Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe
          PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
job <- ReaderT
  (Ptr EvalState)
  IO
  (Maybe
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT
   (Ptr EvalState)
   IO
   (Maybe
      (PSObject
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool])))
 -> MaybeT
      (ReaderT (Ptr EvalState) IO)
      (PSObject
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
forall a b. (a -> b) -> a -> b
$ ByteString
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
Schema.lookupDictBS ByteString
jobName PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
onPush
          PSObject OutputsSchema
outputs <- PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
-> (Map ByteString InputDeclaration
    -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> MaybeT (ReaderT (Ptr EvalState) IO) (PSObject OutputsSchema)
forall (m :: * -> *) (a :: [Attr]).
(MonadEval m, (a . "outputs") ~ OutputsFunction,
 (a ? "extraInputs") ~ ExtraInputsSchema) =>
PSObject (Attrs a)
-> (Map ByteString InputDeclaration -> m (Value NixAttrs))
-> m (PSObject OutputsSchema)
resolveAndInvokeOutputs PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
job (IO (Value NixAttrs)
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Value NixAttrs)
 -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> Map ByteString InputDeclaration
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString InputDeclaration -> IO (Value NixAttrs)
resolveInputs)
          Value NixAttrs
outputAttrs <- PSObject OutputsSchema
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (Value (NixTypeForSchema OutputsSchema))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
Schema.check PSObject OutputsSchema
outputs
          ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT (Ptr EvalState) IO (Maybe RawValue)
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ IO (Maybe RawValue) -> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a. IO a -> ReaderT (Ptr EvalState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RawValue)
 -> ReaderT (Ptr EvalState) IO (Maybe RawValue))
-> IO (Maybe RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState (Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
outputAttrs) [ByteString]
attrPath'
        ByteString
"onSchedule" : [] -> do
          PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool,
          "when" ::?? TimeConstraintsSchema]))
-> RawValue
forall a. PSObject a -> RawValue
Schema.value (PSObject
   (Attrs'
      '[]
      (Attrs
         '["extraInputs" ::? ExtraInputsSchema,
           "outputs" ::. OutputsFunction, "enable" ::? Bool,
           "when" ::?? TimeConstraintsSchema]))
 -> RawValue)
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
forall {a}. Maybe a -> MaybeT (ReaderT (Ptr EvalState) IO) a
require Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
onScheduleMaybe
        ByteString
"onSchedule" : ByteString
jobName : [ByteString]
attrPath' -> do
          PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool,
          "when" ::?? TimeConstraintsSchema]))
onSchedule <- Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs'
           '[]
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
forall {a}. Maybe a -> MaybeT (ReaderT (Ptr EvalState) IO) a
require Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
onScheduleMaybe
          PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool,
       "when" ::?? TimeConstraintsSchema])
job <- ReaderT
  (Ptr EvalState)
  IO
  (Maybe
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema]))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT
   (Ptr EvalState)
   IO
   (Maybe
      (PSObject
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool,
              "when" ::?? TimeConstraintsSchema])))
 -> MaybeT
      (ReaderT (Ptr EvalState) IO)
      (PSObject
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool,
              "when" ::?? TimeConstraintsSchema])))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema]))
forall a b. (a -> b) -> a -> b
$ ByteString
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool,
             "when" ::?? TimeConstraintsSchema]))
-> ReaderT
     (Ptr EvalState)
     IO
     (Maybe
        (PSObject
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool,
                "when" ::?? TimeConstraintsSchema])))
forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
Schema.lookupDictBS ByteString
jobName PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool,
          "when" ::?? TimeConstraintsSchema]))
onSchedule
          PSObject OutputsSchema
outputs <- PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool,
       "when" ::?? TimeConstraintsSchema])
-> (Map ByteString InputDeclaration
    -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> MaybeT (ReaderT (Ptr EvalState) IO) (PSObject OutputsSchema)
forall (m :: * -> *) (a :: [Attr]).
(MonadEval m, (a . "outputs") ~ OutputsFunction,
 (a ? "extraInputs") ~ ExtraInputsSchema) =>
PSObject (Attrs a)
-> (Map ByteString InputDeclaration -> m (Value NixAttrs))
-> m (PSObject OutputsSchema)
resolveAndInvokeOutputs PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool,
       "when" ::?? TimeConstraintsSchema])
job (IO (Value NixAttrs)
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Value NixAttrs)
 -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> Map ByteString InputDeclaration
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString InputDeclaration -> IO (Value NixAttrs)
resolveInputs)
          Value NixAttrs
outputAttrs <- PSObject OutputsSchema
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (Value (NixTypeForSchema OutputsSchema))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
Schema.check PSObject OutputsSchema
outputs
          ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT (Ptr EvalState) IO (Maybe RawValue)
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ IO (Maybe RawValue) -> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a. IO a -> ReaderT (Ptr EvalState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RawValue)
 -> ReaderT (Ptr EvalState) IO (Maybe RawValue))
-> IO (Maybe RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState (Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
outputAttrs) [ByteString]
attrPath'
        [ByteString]
_ ->
          case Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
onPushMaybe of
            Just PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
jobs -> do
              case [ByteString]
attrPath of
                [] -> RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a. a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> RawValue -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> RawValue
forall a. PSObject a -> RawValue
Schema.value PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
jobs -- Technically mapAttrs .outputs, meh
                (ByteString
jobName : [ByteString]
attrPath') -> do
                  ByteString
-> PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool]))
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (Maybe
        (PSObject
           (Attrs
              '["extraInputs" ::? ExtraInputsSchema,
                "outputs" ::. OutputsFunction, "enable" ::? Bool])))
forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
Schema.lookupDictBS ByteString
jobName PSObject
  (Attrs'
     '[]
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
jobs MaybeT
  (ReaderT (Ptr EvalState) IO)
  (Maybe
     (PSObject
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
-> (Maybe
      (PSObject
         (Attrs
            '["extraInputs" ::? ExtraInputsSchema,
              "outputs" ::. OutputsFunction, "enable" ::? Bool]))
    -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b.
MaybeT (ReaderT (Ptr EvalState) IO) a
-> (a -> MaybeT (ReaderT (Ptr EvalState) IO) b)
-> MaybeT (ReaderT (Ptr EvalState) IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
selectedJob -> do
                      PSObject OutputsSchema
outputs <- PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
-> (Map ByteString InputDeclaration
    -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> MaybeT (ReaderT (Ptr EvalState) IO) (PSObject OutputsSchema)
forall (m :: * -> *) (a :: [Attr]).
(MonadEval m, (a . "outputs") ~ OutputsFunction,
 (a ? "extraInputs") ~ ExtraInputsSchema) =>
PSObject (Attrs a)
-> (Map ByteString InputDeclaration -> m (Value NixAttrs))
-> m (PSObject OutputsSchema)
resolveAndInvokeOutputs PSObject
  (Attrs
     '["extraInputs" ::? ExtraInputsSchema,
       "outputs" ::. OutputsFunction, "enable" ::? Bool])
selectedJob (IO (Value NixAttrs)
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall a. IO a -> MaybeT (ReaderT (Ptr EvalState) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Value NixAttrs)
 -> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs))
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> Map ByteString InputDeclaration
-> MaybeT (ReaderT (Ptr EvalState) IO) (Value NixAttrs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ByteString InputDeclaration -> IO (Value NixAttrs)
resolveInputs)
                      Value NixAttrs
outputAttrs <- PSObject OutputsSchema
-> MaybeT
     (ReaderT (Ptr EvalState) IO)
     (Value (NixTypeForSchema OutputsSchema))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
Schema.check PSObject OutputsSchema
outputs
                      ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT (Ptr EvalState) IO (Maybe RawValue)
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ IO (Maybe RawValue) -> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a. IO a -> ReaderT (Ptr EvalState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RawValue)
 -> ReaderT (Ptr EvalState) IO (Maybe RawValue))
-> IO (Maybe RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState (Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
outputAttrs) [ByteString]
attrPath'
                    Maybe
  (PSObject
     (Attrs
        '["extraInputs" ::? ExtraInputsSchema,
          "outputs" ::. OutputsFunction, "enable" ::? Bool]))
Nothing -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a. MaybeT (ReaderT (Ptr EvalState) IO) a
forall (f :: * -> *) a. Alternative f => f a
empty
            Maybe
  (PSObject
     (Attrs'
        '[]
        (Attrs
           '["extraInputs" ::? ExtraInputsSchema,
             "outputs" ::. OutputsFunction, "enable" ::? Bool])))
Nothing -> do
              ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT (Ptr EvalState) IO (Maybe RawValue)
 -> MaybeT (ReaderT (Ptr EvalState) IO) RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
-> MaybeT (ReaderT (Ptr EvalState) IO) RawValue
forall a b. (a -> b) -> a -> b
$ IO (Maybe RawValue) -> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a. IO a -> ReaderT (Ptr EvalState) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RawValue)
 -> ReaderT (Ptr EvalState) IO (Maybe RawValue))
-> IO (Maybe RawValue)
-> ReaderT (Ptr EvalState) IO (Maybe RawValue)
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState (HomeExpr -> RawValue
homeExprRawValue HomeExpr
homeExpr) [ByteString]
attrPath

resolveAndInvokeOutputs ::
  ( MonadEval m,
    a . "outputs" ~ OutputsFunction,
    a ? "extraInputs" ~ ExtraInputsSchema
  ) =>
  PSObject (Attrs a) ->
  (Map ByteString InputDeclaration -> m (Value NixAttrs)) ->
  m (PSObject OutputsSchema)
resolveAndInvokeOutputs :: forall (m :: * -> *) (a :: [Attr]).
(MonadEval m, (a . "outputs") ~ OutputsFunction,
 (a ? "extraInputs") ~ ExtraInputsSchema) =>
PSObject (Attrs a)
-> (Map ByteString InputDeclaration -> m (Value NixAttrs))
-> m (PSObject OutputsSchema)
resolveAndInvokeOutputs PSObject (Attrs a)
job Map ByteString InputDeclaration -> m (Value NixAttrs)
resolveInputs = do
  Maybe (Map ByteString InputDeclaration)
inputs <- PSObject (Attrs a)
job PSObject (Attrs a)
-> AttrLabel "extraInputs"
-> m (Maybe (PSObject (a ? "extraInputs")))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w)
-> AttrLabel s -> m (Maybe (PSObject (as ? s)))
#? AttrLabel "extraInputs"
#extraInputs m (Maybe (PSObject ExtraInputsSchema))
-> (Maybe (PSObject ExtraInputsSchema)
    -> m (Maybe (Map ByteString InputDeclaration)))
-> m (Maybe (Map ByteString InputDeclaration))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration))
-> Maybe (PSObject ExtraInputsSchema)
-> m (Maybe (Map ByteString InputDeclaration))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration)
forall (m :: * -> *).
MonadEval m =>
PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration)
parseExtraInputs
  Value NixAttrs
resolved <- Map ByteString InputDeclaration -> m (Value NixAttrs)
resolveInputs (Map ByteString InputDeclaration
-> Maybe (Map ByteString InputDeclaration)
-> Map ByteString InputDeclaration
forall a. a -> Maybe a -> a
fromMaybe Map ByteString InputDeclaration
forall a. Monoid a => a
mempty Maybe (Map ByteString InputDeclaration)
inputs)
  PSObject OutputsFunction
f <- PSObject (Attrs a)
job PSObject (Attrs a)
-> AttrLabel "outputs" -> m (PSObject (a . "outputs"))
forall {k} (s :: Symbol) (m :: * -> *) (as :: [Attr]) (w :: k).
(KnownSymbol s, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject (as . s))
#. AttrLabel "outputs"
#outputs
  PSObject OutputsFunction
f PSObject OutputsFunction
-> PSObject InputsSchema -> m (PSObject OutputsSchema)
forall (m :: * -> *) b a.
(MonadEval m, PossibleTypesForSchema b) =>
PSObject (a ->? b) -> PSObject a -> m (PSObject b)
$? (PSObject {provenance :: Provenance
provenance = Provenance
Schema.Data, value :: RawValue
value = Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
resolved})

attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
_ RawValue
v [] = Maybe RawValue -> IO (Maybe RawValue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawValue -> Maybe RawValue
forall a. a -> Maybe a
Just RawValue
v)
attrByPath Ptr EvalState
evalState RawValue
v (ByteString
a : [ByteString]
as) = do
  Ptr EvalState -> RawValue -> IO Match
match' Ptr EvalState
evalState RawValue
v IO Match -> (Match -> IO (Maybe RawValue)) -> IO (Maybe RawValue)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    IsAttrs Value NixAttrs
attrs ->
      Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
attrs ByteString
a
        IO (Maybe RawValue)
-> (Maybe RawValue -> IO (Maybe (Maybe RawValue)))
-> IO (Maybe (Maybe RawValue))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RawValue -> IO (Maybe RawValue))
-> Maybe RawValue -> IO (Maybe (Maybe RawValue))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (\RawValue
attrValue -> Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState RawValue
attrValue [ByteString]
as)
        IO (Maybe (Maybe RawValue))
-> (IO (Maybe (Maybe RawValue)) -> IO (Maybe RawValue))
-> IO (Maybe RawValue)
forall a b. a -> (a -> b) -> b
& (Maybe (Maybe RawValue) -> Maybe RawValue)
-> IO (Maybe (Maybe RawValue)) -> IO (Maybe RawValue)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe RawValue) -> Maybe RawValue
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    Match
_ -> Maybe RawValue -> IO (Maybe RawValue)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RawValue
forall a. Maybe a
Nothing

loadDefaultHerculesCI :: (MonadEval m) => m (PSObject DefaultHerculesCIHelperSchema)
loadDefaultHerculesCI :: forall (m :: * -> *).
MonadEval m =>
m (PSObject DefaultHerculesCIHelperSchema)
loadDefaultHerculesCI = do
  FilePath
fname <- IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getDataFileName FilePath
"data/default-herculesCI-for-flake.nix"
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> ByteString -> IO ()
addAllowedPath Ptr EvalState
evalState (ByteString -> IO ())
-> (FilePath -> ByteString) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
fname
  RawValue
v <- IO RawValue -> m RawValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> m RawValue) -> IO RawValue -> m RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> FilePath -> IO RawValue
evalFile Ptr EvalState
evalState FilePath
fname
  PSObject DefaultHerculesCIHelperSchema
-> m (PSObject DefaultHerculesCIHelperSchema)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PSObject {value :: RawValue
value = RawValue
v, provenance :: Provenance
provenance = Text -> Provenance
Other Text
"<default herculesCI helper shim>"})