{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Hercules.API.Agent.Evaluate.EvaluateTask where

import Data.Aeson (Value)
import Hercules.API.Agent.Evaluate.EvaluateTask.OnPush (OnPush)
import Hercules.API.Agent.Evaluate.ImmutableInput (ImmutableInput)
import Hercules.API.Prelude
import Hercules.API.Task (Task)

data EvaluateTask = EvaluateTask
  { EvaluateTask -> Id (Task EvaluateTask)
id :: Id (Task EvaluateTask),
    EvaluateTask -> Text
primaryInput :: Text, -- Obsolete since >= 0.8
    EvaluateTask -> Map Text Text
otherInputs :: Map Identifier Text, -- identifier -> HTTP URL
    EvaluateTask -> Map Text (Map Text Value)
inputMetadata :: Map Identifier (Map Text Value),
    EvaluateTask -> Map Text ImmutableInput
inputs :: Map Identifier ImmutableInput,
    EvaluateTask -> Map Text (SubPathOf Text)
autoArguments :: Map Text (SubPathOf Identifier), -- argument name -> identifier
    EvaluateTask -> [NixPathElement (SubPathOf Text)]
nixPath :: [NixPathElement (SubPathOf Identifier)], -- NIX_PATH element -> identifier
    EvaluateTask -> Text
logToken :: Text,
    EvaluateTask -> Selector
selector :: Selector,
    EvaluateTask -> Maybe (Map Text ())
ciSystems :: Maybe (Map Text ()),
    EvaluateTask -> Maybe [Credential]
extraGitCredentials :: Maybe [Credential],
    -- | Whether to use Nix's fetching mechanism for everything.
    --
    -- Putting checkouts in the store isn't always desirable, so we keep the
    -- non-flake behavior of custom checkouts for non-flake use cases.
    EvaluateTask -> Bool
isFlakeJob :: Bool
  }
  deriving ((forall x. EvaluateTask -> Rep EvaluateTask x)
-> (forall x. Rep EvaluateTask x -> EvaluateTask)
-> Generic EvaluateTask
forall x. Rep EvaluateTask x -> EvaluateTask
forall x. EvaluateTask -> Rep EvaluateTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluateTask x -> EvaluateTask
$cfrom :: forall x. EvaluateTask -> Rep EvaluateTask x
Generic, Int -> EvaluateTask -> ShowS
[EvaluateTask] -> ShowS
EvaluateTask -> String
(Int -> EvaluateTask -> ShowS)
-> (EvaluateTask -> String)
-> ([EvaluateTask] -> ShowS)
-> Show EvaluateTask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateTask] -> ShowS
$cshowList :: [EvaluateTask] -> ShowS
show :: EvaluateTask -> String
$cshow :: EvaluateTask -> String
showsPrec :: Int -> EvaluateTask -> ShowS
$cshowsPrec :: Int -> EvaluateTask -> ShowS
Show, EvaluateTask -> EvaluateTask -> Bool
(EvaluateTask -> EvaluateTask -> Bool)
-> (EvaluateTask -> EvaluateTask -> Bool) -> Eq EvaluateTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateTask -> EvaluateTask -> Bool
$c/= :: EvaluateTask -> EvaluateTask -> Bool
== :: EvaluateTask -> EvaluateTask -> Bool
$c== :: EvaluateTask -> EvaluateTask -> Bool
Eq, EvaluateTask -> ()
(EvaluateTask -> ()) -> NFData EvaluateTask
forall a. (a -> ()) -> NFData a
rnf :: EvaluateTask -> ()
$crnf :: EvaluateTask -> ()
NFData, [EvaluateTask] -> Encoding
[EvaluateTask] -> Value
EvaluateTask -> Encoding
EvaluateTask -> Value
(EvaluateTask -> Value)
-> (EvaluateTask -> Encoding)
-> ([EvaluateTask] -> Value)
-> ([EvaluateTask] -> Encoding)
-> ToJSON EvaluateTask
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EvaluateTask] -> Encoding
$ctoEncodingList :: [EvaluateTask] -> Encoding
toJSONList :: [EvaluateTask] -> Value
$ctoJSONList :: [EvaluateTask] -> Value
toEncoding :: EvaluateTask -> Encoding
$ctoEncoding :: EvaluateTask -> Encoding
toJSON :: EvaluateTask -> Value
$ctoJSON :: EvaluateTask -> Value
ToJSON, Value -> Parser [EvaluateTask]
Value -> Parser EvaluateTask
(Value -> Parser EvaluateTask)
-> (Value -> Parser [EvaluateTask]) -> FromJSON EvaluateTask
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EvaluateTask]
$cparseJSONList :: Value -> Parser [EvaluateTask]
parseJSON :: Value -> Parser EvaluateTask
$cparseJSON :: Value -> Parser EvaluateTask
FromJSON)

data Credential = Credential
  { Credential -> Text
url :: Text,
    Credential -> Text
username :: Text,
    Credential -> Text
password :: Text
  }
  deriving ((forall x. Credential -> Rep Credential x)
-> (forall x. Rep Credential x -> Credential) -> Generic Credential
forall x. Rep Credential x -> Credential
forall x. Credential -> Rep Credential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Credential x -> Credential
$cfrom :: forall x. Credential -> Rep Credential x
Generic, Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> Credential -> ShowS
Show, Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq, Credential -> ()
(Credential -> ()) -> NFData Credential
forall a. (a -> ()) -> NFData a
rnf :: Credential -> ()
$crnf :: Credential -> ()
NFData, [Credential] -> Encoding
[Credential] -> Value
Credential -> Encoding
Credential -> Value
(Credential -> Value)
-> (Credential -> Encoding)
-> ([Credential] -> Value)
-> ([Credential] -> Encoding)
-> ToJSON Credential
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Credential] -> Encoding
$ctoEncodingList :: [Credential] -> Encoding
toJSONList :: [Credential] -> Value
$ctoJSONList :: [Credential] -> Value
toEncoding :: Credential -> Encoding
$ctoEncoding :: Credential -> Encoding
toJSON :: Credential -> Value
$ctoJSON :: Credential -> Value
ToJSON, Value -> Parser [Credential]
Value -> Parser Credential
(Value -> Parser Credential)
-> (Value -> Parser [Credential]) -> FromJSON Credential
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Credential]
$cparseJSONList :: Value -> Parser [Credential]
parseJSON :: Value -> Parser Credential
$cparseJSON :: Value -> Parser Credential
FromJSON)

data Selector
  = ConfigOrLegacy
  | OnPush OnPush
  deriving ((forall x. Selector -> Rep Selector x)
-> (forall x. Rep Selector x -> Selector) -> Generic Selector
forall x. Rep Selector x -> Selector
forall x. Selector -> Rep Selector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Selector x -> Selector
$cfrom :: forall x. Selector -> Rep Selector x
Generic, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, Selector -> ()
(Selector -> ()) -> NFData Selector
forall a. (a -> ()) -> NFData a
rnf :: Selector -> ()
$crnf :: Selector -> ()
NFData, [Selector] -> Encoding
[Selector] -> Value
Selector -> Encoding
Selector -> Value
(Selector -> Value)
-> (Selector -> Encoding)
-> ([Selector] -> Value)
-> ([Selector] -> Encoding)
-> ToJSON Selector
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Selector] -> Encoding
$ctoEncodingList :: [Selector] -> Encoding
toJSONList :: [Selector] -> Value
$ctoJSONList :: [Selector] -> Value
toEncoding :: Selector -> Encoding
$ctoEncoding :: Selector -> Encoding
toJSON :: Selector -> Value
$ctoJSON :: Selector -> Value
ToJSON, Value -> Parser [Selector]
Value -> Parser Selector
(Value -> Parser Selector)
-> (Value -> Parser [Selector]) -> FromJSON Selector
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Selector]
$cparseJSONList :: Value -> Parser [Selector]
parseJSON :: Value -> Parser Selector
$cparseJSON :: Value -> Parser Selector
FromJSON)

type Identifier = Text

data NixPathElement a = NixPathElement
  { -- | for example @/home/user/nixpkgs@ in @/home/user/nixpkgs:/etc/nixos/foo@
    forall a. NixPathElement a -> Maybe Text
prefix :: Maybe Text,
    forall a. NixPathElement a -> a
value :: a
  }
  deriving ((forall x. NixPathElement a -> Rep (NixPathElement a) x)
-> (forall x. Rep (NixPathElement a) x -> NixPathElement a)
-> Generic (NixPathElement a)
forall x. Rep (NixPathElement a) x -> NixPathElement a
forall x. NixPathElement a -> Rep (NixPathElement a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NixPathElement a) x -> NixPathElement a
forall a x. NixPathElement a -> Rep (NixPathElement a) x
$cto :: forall a x. Rep (NixPathElement a) x -> NixPathElement a
$cfrom :: forall a x. NixPathElement a -> Rep (NixPathElement a) x
Generic, Int -> NixPathElement a -> ShowS
[NixPathElement a] -> ShowS
NixPathElement a -> String
(Int -> NixPathElement a -> ShowS)
-> (NixPathElement a -> String)
-> ([NixPathElement a] -> ShowS)
-> Show (NixPathElement a)
forall a. Show a => Int -> NixPathElement a -> ShowS
forall a. Show a => [NixPathElement a] -> ShowS
forall a. Show a => NixPathElement a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixPathElement a] -> ShowS
$cshowList :: forall a. Show a => [NixPathElement a] -> ShowS
show :: NixPathElement a -> String
$cshow :: forall a. Show a => NixPathElement a -> String
showsPrec :: Int -> NixPathElement a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NixPathElement a -> ShowS
Show, NixPathElement a -> NixPathElement a -> Bool
(NixPathElement a -> NixPathElement a -> Bool)
-> (NixPathElement a -> NixPathElement a -> Bool)
-> Eq (NixPathElement a)
forall a. Eq a => NixPathElement a -> NixPathElement a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixPathElement a -> NixPathElement a -> Bool
$c/= :: forall a. Eq a => NixPathElement a -> NixPathElement a -> Bool
== :: NixPathElement a -> NixPathElement a -> Bool
$c== :: forall a. Eq a => NixPathElement a -> NixPathElement a -> Bool
Eq, NixPathElement a -> ()
(NixPathElement a -> ()) -> NFData (NixPathElement a)
forall a. NFData a => NixPathElement a -> ()
forall a. (a -> ()) -> NFData a
rnf :: NixPathElement a -> ()
$crnf :: forall a. NFData a => NixPathElement a -> ()
NFData, [NixPathElement a] -> Encoding
[NixPathElement a] -> Value
NixPathElement a -> Encoding
NixPathElement a -> Value
(NixPathElement a -> Value)
-> (NixPathElement a -> Encoding)
-> ([NixPathElement a] -> Value)
-> ([NixPathElement a] -> Encoding)
-> ToJSON (NixPathElement a)
forall a. ToJSON a => [NixPathElement a] -> Encoding
forall a. ToJSON a => [NixPathElement a] -> Value
forall a. ToJSON a => NixPathElement a -> Encoding
forall a. ToJSON a => NixPathElement a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NixPathElement a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [NixPathElement a] -> Encoding
toJSONList :: [NixPathElement a] -> Value
$ctoJSONList :: forall a. ToJSON a => [NixPathElement a] -> Value
toEncoding :: NixPathElement a -> Encoding
$ctoEncoding :: forall a. ToJSON a => NixPathElement a -> Encoding
toJSON :: NixPathElement a -> Value
$ctoJSON :: forall a. ToJSON a => NixPathElement a -> Value
ToJSON, Value -> Parser [NixPathElement a]
Value -> Parser (NixPathElement a)
(Value -> Parser (NixPathElement a))
-> (Value -> Parser [NixPathElement a])
-> FromJSON (NixPathElement a)
forall a. FromJSON a => Value -> Parser [NixPathElement a]
forall a. FromJSON a => Value -> Parser (NixPathElement a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NixPathElement a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [NixPathElement a]
parseJSON :: Value -> Parser (NixPathElement a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (NixPathElement a)
FromJSON, (forall a b. (a -> b) -> NixPathElement a -> NixPathElement b)
-> (forall a b. a -> NixPathElement b -> NixPathElement a)
-> Functor NixPathElement
forall a b. a -> NixPathElement b -> NixPathElement a
forall a b. (a -> b) -> NixPathElement a -> NixPathElement b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> NixPathElement b -> NixPathElement a
$c<$ :: forall a b. a -> NixPathElement b -> NixPathElement a
fmap :: forall a b. (a -> b) -> NixPathElement a -> NixPathElement b
$cfmap :: forall a b. (a -> b) -> NixPathElement a -> NixPathElement b
Functor, (forall m. Monoid m => NixPathElement m -> m)
-> (forall m a. Monoid m => (a -> m) -> NixPathElement a -> m)
-> (forall m a. Monoid m => (a -> m) -> NixPathElement a -> m)
-> (forall a b. (a -> b -> b) -> b -> NixPathElement a -> b)
-> (forall a b. (a -> b -> b) -> b -> NixPathElement a -> b)
-> (forall b a. (b -> a -> b) -> b -> NixPathElement a -> b)
-> (forall b a. (b -> a -> b) -> b -> NixPathElement a -> b)
-> (forall a. (a -> a -> a) -> NixPathElement a -> a)
-> (forall a. (a -> a -> a) -> NixPathElement a -> a)
-> (forall a. NixPathElement a -> [a])
-> (forall a. NixPathElement a -> Bool)
-> (forall a. NixPathElement a -> Int)
-> (forall a. Eq a => a -> NixPathElement a -> Bool)
-> (forall a. Ord a => NixPathElement a -> a)
-> (forall a. Ord a => NixPathElement a -> a)
-> (forall a. Num a => NixPathElement a -> a)
-> (forall a. Num a => NixPathElement a -> a)
-> Foldable NixPathElement
forall a. Eq a => a -> NixPathElement a -> Bool
forall a. Num a => NixPathElement a -> a
forall a. Ord a => NixPathElement a -> a
forall m. Monoid m => NixPathElement m -> m
forall a. NixPathElement a -> Bool
forall a. NixPathElement a -> Int
forall a. NixPathElement a -> [a]
forall a. (a -> a -> a) -> NixPathElement a -> a
forall m a. Monoid m => (a -> m) -> NixPathElement a -> m
forall b a. (b -> a -> b) -> b -> NixPathElement a -> b
forall a b. (a -> b -> b) -> b -> NixPathElement a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => NixPathElement a -> a
$cproduct :: forall a. Num a => NixPathElement a -> a
sum :: forall a. Num a => NixPathElement a -> a
$csum :: forall a. Num a => NixPathElement a -> a
minimum :: forall a. Ord a => NixPathElement a -> a
$cminimum :: forall a. Ord a => NixPathElement a -> a
maximum :: forall a. Ord a => NixPathElement a -> a
$cmaximum :: forall a. Ord a => NixPathElement a -> a
elem :: forall a. Eq a => a -> NixPathElement a -> Bool
$celem :: forall a. Eq a => a -> NixPathElement a -> Bool
length :: forall a. NixPathElement a -> Int
$clength :: forall a. NixPathElement a -> Int
null :: forall a. NixPathElement a -> Bool
$cnull :: forall a. NixPathElement a -> Bool
toList :: forall a. NixPathElement a -> [a]
$ctoList :: forall a. NixPathElement a -> [a]
foldl1 :: forall a. (a -> a -> a) -> NixPathElement a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NixPathElement a -> a
foldr1 :: forall a. (a -> a -> a) -> NixPathElement a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NixPathElement a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> NixPathElement a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NixPathElement a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NixPathElement a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NixPathElement a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NixPathElement a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NixPathElement a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NixPathElement a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NixPathElement a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> NixPathElement a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NixPathElement a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NixPathElement a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NixPathElement a -> m
fold :: forall m. Monoid m => NixPathElement m -> m
$cfold :: forall m. Monoid m => NixPathElement m -> m
Foldable, Functor NixPathElement
Foldable NixPathElement
Functor NixPathElement
-> Foldable NixPathElement
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NixPathElement a -> f (NixPathElement b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NixPathElement (f a) -> f (NixPathElement a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NixPathElement a -> m (NixPathElement b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NixPathElement (m a) -> m (NixPathElement a))
-> Traversable NixPathElement
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NixPathElement (m a) -> m (NixPathElement a)
forall (f :: * -> *) a.
Applicative f =>
NixPathElement (f a) -> f (NixPathElement a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NixPathElement a -> m (NixPathElement b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NixPathElement a -> f (NixPathElement b)
sequence :: forall (m :: * -> *) a.
Monad m =>
NixPathElement (m a) -> m (NixPathElement a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NixPathElement (m a) -> m (NixPathElement a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NixPathElement a -> m (NixPathElement b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NixPathElement a -> m (NixPathElement b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NixPathElement (f a) -> f (NixPathElement a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NixPathElement (f a) -> f (NixPathElement a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NixPathElement a -> f (NixPathElement b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NixPathElement a -> f (NixPathElement b)
Traversable)

-- | For using a path inside a source
data SubPathOf a = SubPathOf
  { forall a. SubPathOf a -> a
path :: a,
    forall a. SubPathOf a -> Maybe Text
subPath :: Maybe Text
  }
  deriving ((forall x. SubPathOf a -> Rep (SubPathOf a) x)
-> (forall x. Rep (SubPathOf a) x -> SubPathOf a)
-> Generic (SubPathOf a)
forall x. Rep (SubPathOf a) x -> SubPathOf a
forall x. SubPathOf a -> Rep (SubPathOf a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SubPathOf a) x -> SubPathOf a
forall a x. SubPathOf a -> Rep (SubPathOf a) x
$cto :: forall a x. Rep (SubPathOf a) x -> SubPathOf a
$cfrom :: forall a x. SubPathOf a -> Rep (SubPathOf a) x
Generic, Int -> SubPathOf a -> ShowS
[SubPathOf a] -> ShowS
SubPathOf a -> String
(Int -> SubPathOf a -> ShowS)
-> (SubPathOf a -> String)
-> ([SubPathOf a] -> ShowS)
-> Show (SubPathOf a)
forall a. Show a => Int -> SubPathOf a -> ShowS
forall a. Show a => [SubPathOf a] -> ShowS
forall a. Show a => SubPathOf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubPathOf a] -> ShowS
$cshowList :: forall a. Show a => [SubPathOf a] -> ShowS
show :: SubPathOf a -> String
$cshow :: forall a. Show a => SubPathOf a -> String
showsPrec :: Int -> SubPathOf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SubPathOf a -> ShowS
Show, SubPathOf a -> SubPathOf a -> Bool
(SubPathOf a -> SubPathOf a -> Bool)
-> (SubPathOf a -> SubPathOf a -> Bool) -> Eq (SubPathOf a)
forall a. Eq a => SubPathOf a -> SubPathOf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubPathOf a -> SubPathOf a -> Bool
$c/= :: forall a. Eq a => SubPathOf a -> SubPathOf a -> Bool
== :: SubPathOf a -> SubPathOf a -> Bool
$c== :: forall a. Eq a => SubPathOf a -> SubPathOf a -> Bool
Eq, SubPathOf a -> ()
(SubPathOf a -> ()) -> NFData (SubPathOf a)
forall a. NFData a => SubPathOf a -> ()
forall a. (a -> ()) -> NFData a
rnf :: SubPathOf a -> ()
$crnf :: forall a. NFData a => SubPathOf a -> ()
NFData, [SubPathOf a] -> Encoding
[SubPathOf a] -> Value
SubPathOf a -> Encoding
SubPathOf a -> Value
(SubPathOf a -> Value)
-> (SubPathOf a -> Encoding)
-> ([SubPathOf a] -> Value)
-> ([SubPathOf a] -> Encoding)
-> ToJSON (SubPathOf a)
forall a. ToJSON a => [SubPathOf a] -> Encoding
forall a. ToJSON a => [SubPathOf a] -> Value
forall a. ToJSON a => SubPathOf a -> Encoding
forall a. ToJSON a => SubPathOf a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SubPathOf a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [SubPathOf a] -> Encoding
toJSONList :: [SubPathOf a] -> Value
$ctoJSONList :: forall a. ToJSON a => [SubPathOf a] -> Value
toEncoding :: SubPathOf a -> Encoding
$ctoEncoding :: forall a. ToJSON a => SubPathOf a -> Encoding
toJSON :: SubPathOf a -> Value
$ctoJSON :: forall a. ToJSON a => SubPathOf a -> Value
ToJSON, Value -> Parser [SubPathOf a]
Value -> Parser (SubPathOf a)
(Value -> Parser (SubPathOf a))
-> (Value -> Parser [SubPathOf a]) -> FromJSON (SubPathOf a)
forall a. FromJSON a => Value -> Parser [SubPathOf a]
forall a. FromJSON a => Value -> Parser (SubPathOf a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SubPathOf a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [SubPathOf a]
parseJSON :: Value -> Parser (SubPathOf a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (SubPathOf a)
FromJSON, (forall a b. (a -> b) -> SubPathOf a -> SubPathOf b)
-> (forall a b. a -> SubPathOf b -> SubPathOf a)
-> Functor SubPathOf
forall a b. a -> SubPathOf b -> SubPathOf a
forall a b. (a -> b) -> SubPathOf a -> SubPathOf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SubPathOf b -> SubPathOf a
$c<$ :: forall a b. a -> SubPathOf b -> SubPathOf a
fmap :: forall a b. (a -> b) -> SubPathOf a -> SubPathOf b
$cfmap :: forall a b. (a -> b) -> SubPathOf a -> SubPathOf b
Functor, (forall m. Monoid m => SubPathOf m -> m)
-> (forall m a. Monoid m => (a -> m) -> SubPathOf a -> m)
-> (forall m a. Monoid m => (a -> m) -> SubPathOf a -> m)
-> (forall a b. (a -> b -> b) -> b -> SubPathOf a -> b)
-> (forall a b. (a -> b -> b) -> b -> SubPathOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> SubPathOf a -> b)
-> (forall b a. (b -> a -> b) -> b -> SubPathOf a -> b)
-> (forall a. (a -> a -> a) -> SubPathOf a -> a)
-> (forall a. (a -> a -> a) -> SubPathOf a -> a)
-> (forall a. SubPathOf a -> [a])
-> (forall a. SubPathOf a -> Bool)
-> (forall a. SubPathOf a -> Int)
-> (forall a. Eq a => a -> SubPathOf a -> Bool)
-> (forall a. Ord a => SubPathOf a -> a)
-> (forall a. Ord a => SubPathOf a -> a)
-> (forall a. Num a => SubPathOf a -> a)
-> (forall a. Num a => SubPathOf a -> a)
-> Foldable SubPathOf
forall a. Eq a => a -> SubPathOf a -> Bool
forall a. Num a => SubPathOf a -> a
forall a. Ord a => SubPathOf a -> a
forall m. Monoid m => SubPathOf m -> m
forall a. SubPathOf a -> Bool
forall a. SubPathOf a -> Int
forall a. SubPathOf a -> [a]
forall a. (a -> a -> a) -> SubPathOf a -> a
forall m a. Monoid m => (a -> m) -> SubPathOf a -> m
forall b a. (b -> a -> b) -> b -> SubPathOf a -> b
forall a b. (a -> b -> b) -> b -> SubPathOf a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => SubPathOf a -> a
$cproduct :: forall a. Num a => SubPathOf a -> a
sum :: forall a. Num a => SubPathOf a -> a
$csum :: forall a. Num a => SubPathOf a -> a
minimum :: forall a. Ord a => SubPathOf a -> a
$cminimum :: forall a. Ord a => SubPathOf a -> a
maximum :: forall a. Ord a => SubPathOf a -> a
$cmaximum :: forall a. Ord a => SubPathOf a -> a
elem :: forall a. Eq a => a -> SubPathOf a -> Bool
$celem :: forall a. Eq a => a -> SubPathOf a -> Bool
length :: forall a. SubPathOf a -> Int
$clength :: forall a. SubPathOf a -> Int
null :: forall a. SubPathOf a -> Bool
$cnull :: forall a. SubPathOf a -> Bool
toList :: forall a. SubPathOf a -> [a]
$ctoList :: forall a. SubPathOf a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SubPathOf a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SubPathOf a -> a
foldr1 :: forall a. (a -> a -> a) -> SubPathOf a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SubPathOf a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SubPathOf a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SubPathOf a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SubPathOf a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SubPathOf a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SubPathOf a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SubPathOf a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SubPathOf a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SubPathOf a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SubPathOf a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SubPathOf a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SubPathOf a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SubPathOf a -> m
fold :: forall m. Monoid m => SubPathOf m -> m
$cfold :: forall m. Monoid m => SubPathOf m -> m
Foldable, Functor SubPathOf
Foldable SubPathOf
Functor SubPathOf
-> Foldable SubPathOf
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SubPathOf a -> f (SubPathOf b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SubPathOf (f a) -> f (SubPathOf a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SubPathOf a -> m (SubPathOf b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SubPathOf (m a) -> m (SubPathOf a))
-> Traversable SubPathOf
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SubPathOf (m a) -> m (SubPathOf a)
forall (f :: * -> *) a.
Applicative f =>
SubPathOf (f a) -> f (SubPathOf a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SubPathOf a -> m (SubPathOf b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SubPathOf a -> f (SubPathOf b)
sequence :: forall (m :: * -> *) a.
Monad m =>
SubPathOf (m a) -> m (SubPathOf a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SubPathOf (m a) -> m (SubPathOf a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SubPathOf a -> m (SubPathOf b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SubPathOf a -> m (SubPathOf b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SubPathOf (f a) -> f (SubPathOf a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SubPathOf (f a) -> f (SubPathOf a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SubPathOf a -> f (SubPathOf b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SubPathOf a -> f (SubPathOf b)
Traversable)