{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE DeriveFunctor  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE KindSignatures  #-}

-- | Shared types

module Nix.Derivation.Types
    ( -- * Types
      Derivation(..)
    , DerivationOutput(..)
    ) where

import Control.DeepSeq (NFData)
import Data.Map (Map)
import Data.Set (Set)
import Data.Vector (Vector)
import GHC.Generics (Generic)

-- | A Nix derivation
data Derivation fp txt = Derivation
    { Derivation fp txt -> Map txt (DerivationOutput fp txt)
outputs   :: Map txt (DerivationOutput fp txt)
    -- ^ Outputs produced by this derivation where keys are output names
    , Derivation fp txt -> Map fp (Set txt)
inputDrvs :: Map fp (Set txt)
    -- ^ Inputs that are derivations where keys specify derivation paths and
    -- values specify which output names are used by this derivation
    , Derivation fp txt -> Set fp
inputSrcs :: Set fp
    -- ^ Inputs that are sources
    , Derivation fp txt -> txt
platform  :: txt
    -- ^ Platform required for this derivation
    , Derivation fp txt -> txt
builder   :: txt
    -- ^ Code to build the derivation, which can be a path or a builtin function
    , Derivation fp txt -> Vector txt
args      :: Vector txt
    -- ^ Arguments passed to the executable used to build to derivation
    , Derivation fp txt -> Map txt txt
env       :: Map txt txt
    -- ^ Environment variables provided to the executable used to build the
    -- derivation
    } deriving (Derivation fp txt -> Derivation fp txt -> Bool
(Derivation fp txt -> Derivation fp txt -> Bool)
-> (Derivation fp txt -> Derivation fp txt -> Bool)
-> Eq (Derivation fp txt)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall fp txt.
(Eq txt, Eq fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
/= :: Derivation fp txt -> Derivation fp txt -> Bool
$c/= :: forall fp txt.
(Eq txt, Eq fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
== :: Derivation fp txt -> Derivation fp txt -> Bool
$c== :: forall fp txt.
(Eq txt, Eq fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
Eq, (forall x. Derivation fp txt -> Rep (Derivation fp txt) x)
-> (forall x. Rep (Derivation fp txt) x -> Derivation fp txt)
-> Generic (Derivation fp txt)
forall x. Rep (Derivation fp txt) x -> Derivation fp txt
forall x. Derivation fp txt -> Rep (Derivation fp txt) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall fp txt x. Rep (Derivation fp txt) x -> Derivation fp txt
forall fp txt x. Derivation fp txt -> Rep (Derivation fp txt) x
$cto :: forall fp txt x. Rep (Derivation fp txt) x -> Derivation fp txt
$cfrom :: forall fp txt x. Derivation fp txt -> Rep (Derivation fp txt) x
Generic, Eq (Derivation fp txt)
Eq (Derivation fp txt)
-> (Derivation fp txt -> Derivation fp txt -> Ordering)
-> (Derivation fp txt -> Derivation fp txt -> Bool)
-> (Derivation fp txt -> Derivation fp txt -> Bool)
-> (Derivation fp txt -> Derivation fp txt -> Bool)
-> (Derivation fp txt -> Derivation fp txt -> Bool)
-> (Derivation fp txt -> Derivation fp txt -> Derivation fp txt)
-> (Derivation fp txt -> Derivation fp txt -> Derivation fp txt)
-> Ord (Derivation fp txt)
Derivation fp txt -> Derivation fp txt -> Bool
Derivation fp txt -> Derivation fp txt -> Ordering
Derivation fp txt -> Derivation fp txt -> Derivation fp txt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall fp txt. (Ord txt, Ord fp) => Eq (Derivation fp txt)
forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Ordering
forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Derivation fp txt
min :: Derivation fp txt -> Derivation fp txt -> Derivation fp txt
$cmin :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Derivation fp txt
max :: Derivation fp txt -> Derivation fp txt -> Derivation fp txt
$cmax :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Derivation fp txt
>= :: Derivation fp txt -> Derivation fp txt -> Bool
$c>= :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
> :: Derivation fp txt -> Derivation fp txt -> Bool
$c> :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
<= :: Derivation fp txt -> Derivation fp txt -> Bool
$c<= :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
< :: Derivation fp txt -> Derivation fp txt -> Bool
$c< :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Bool
compare :: Derivation fp txt -> Derivation fp txt -> Ordering
$ccompare :: forall fp txt.
(Ord txt, Ord fp) =>
Derivation fp txt -> Derivation fp txt -> Ordering
$cp1Ord :: forall fp txt. (Ord txt, Ord fp) => Eq (Derivation fp txt)
Ord, Int -> Derivation fp txt -> ShowS
[Derivation fp txt] -> ShowS
Derivation fp txt -> String
(Int -> Derivation fp txt -> ShowS)
-> (Derivation fp txt -> String)
-> ([Derivation fp txt] -> ShowS)
-> Show (Derivation fp txt)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall fp txt.
(Show txt, Show fp) =>
Int -> Derivation fp txt -> ShowS
forall fp txt. (Show txt, Show fp) => [Derivation fp txt] -> ShowS
forall fp txt. (Show txt, Show fp) => Derivation fp txt -> String
showList :: [Derivation fp txt] -> ShowS
$cshowList :: forall fp txt. (Show txt, Show fp) => [Derivation fp txt] -> ShowS
show :: Derivation fp txt -> String
$cshow :: forall fp txt. (Show txt, Show fp) => Derivation fp txt -> String
showsPrec :: Int -> Derivation fp txt -> ShowS
$cshowsPrec :: forall fp txt.
(Show txt, Show fp) =>
Int -> Derivation fp txt -> ShowS
Show)

instance (NFData a, NFData b) => NFData (Derivation a b)

-- | An output of a Nix derivation
data DerivationOutput fp txt = DerivationOutput
    { DerivationOutput fp txt -> fp
path     :: fp
    -- ^ Path where the output will be saved
    , DerivationOutput fp txt -> txt
hashAlgo :: txt
    -- ^ Hash used for expected hash computation
    , DerivationOutput fp txt -> txt
hash     :: txt
    -- ^ Expected hash
    } deriving (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
(DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> Eq (DerivationOutput fp txt)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall fp txt.
(Eq fp, Eq txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
/= :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c/= :: forall fp txt.
(Eq fp, Eq txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
== :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c== :: forall fp txt.
(Eq fp, Eq txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
Eq, (forall x.
 DerivationOutput fp txt -> Rep (DerivationOutput fp txt) x)
-> (forall x.
    Rep (DerivationOutput fp txt) x -> DerivationOutput fp txt)
-> Generic (DerivationOutput fp txt)
forall x.
Rep (DerivationOutput fp txt) x -> DerivationOutput fp txt
forall x.
DerivationOutput fp txt -> Rep (DerivationOutput fp txt) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall fp txt x.
Rep (DerivationOutput fp txt) x -> DerivationOutput fp txt
forall fp txt x.
DerivationOutput fp txt -> Rep (DerivationOutput fp txt) x
$cto :: forall fp txt x.
Rep (DerivationOutput fp txt) x -> DerivationOutput fp txt
$cfrom :: forall fp txt x.
DerivationOutput fp txt -> Rep (DerivationOutput fp txt) x
Generic, Eq (DerivationOutput fp txt)
Eq (DerivationOutput fp txt)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Ordering)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> (DerivationOutput fp txt -> DerivationOutput fp txt -> Bool)
-> (DerivationOutput fp txt
    -> DerivationOutput fp txt -> DerivationOutput fp txt)
-> (DerivationOutput fp txt
    -> DerivationOutput fp txt -> DerivationOutput fp txt)
-> Ord (DerivationOutput fp txt)
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
DerivationOutput fp txt -> DerivationOutput fp txt -> Ordering
DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall fp txt. (Ord fp, Ord txt) => Eq (DerivationOutput fp txt)
forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Ordering
forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
min :: DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
$cmin :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
max :: DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
$cmax :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt
-> DerivationOutput fp txt -> DerivationOutput fp txt
>= :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c>= :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
> :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c> :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
<= :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c<= :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
< :: DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
$c< :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Bool
compare :: DerivationOutput fp txt -> DerivationOutput fp txt -> Ordering
$ccompare :: forall fp txt.
(Ord fp, Ord txt) =>
DerivationOutput fp txt -> DerivationOutput fp txt -> Ordering
$cp1Ord :: forall fp txt. (Ord fp, Ord txt) => Eq (DerivationOutput fp txt)
Ord, Int -> DerivationOutput fp txt -> ShowS
[DerivationOutput fp txt] -> ShowS
DerivationOutput fp txt -> String
(Int -> DerivationOutput fp txt -> ShowS)
-> (DerivationOutput fp txt -> String)
-> ([DerivationOutput fp txt] -> ShowS)
-> Show (DerivationOutput fp txt)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall fp txt.
(Show fp, Show txt) =>
Int -> DerivationOutput fp txt -> ShowS
forall fp txt.
(Show fp, Show txt) =>
[DerivationOutput fp txt] -> ShowS
forall fp txt.
(Show fp, Show txt) =>
DerivationOutput fp txt -> String
showList :: [DerivationOutput fp txt] -> ShowS
$cshowList :: forall fp txt.
(Show fp, Show txt) =>
[DerivationOutput fp txt] -> ShowS
show :: DerivationOutput fp txt -> String
$cshow :: forall fp txt.
(Show fp, Show txt) =>
DerivationOutput fp txt -> String
showsPrec :: Int -> DerivationOutput fp txt -> ShowS
$cshowsPrec :: forall fp txt.
(Show fp, Show txt) =>
Int -> DerivationOutput fp txt -> ShowS
Show)

instance (NFData a, NFData b) => NFData (DerivationOutput a b)