{-# LANGUAGE OverloadedStrings #-}

module System.Nix.DerivedPath (
    OutputsSpec(..)
  , DerivedPath(..)
  , ParseOutputsError(..)
  , parseOutputsSpec
  , outputsSpecToText
  , parseDerivedPath
  , derivedPathToText
  ) where

import GHC.Generics (Generic)
import Data.Set (Set)
import Data.Text (Text)
import System.Nix.OutputName (OutputName, InvalidNameError)
import System.Nix.StorePath (StoreDir(..), StorePath, InvalidPathError)

import qualified Data.Bifunctor
import qualified Data.ByteString.Char8
import qualified Data.Set
import qualified Data.Text
import qualified System.Nix.OutputName
import qualified System.Nix.StorePath

data OutputsSpec =
    OutputsSpec_All
  -- ^ Wildcard spec (^*) meaning all outputs
  | OutputsSpec_Names (Set OutputName)
  -- ^ Set of specific outputs
  deriving (OutputsSpec -> OutputsSpec -> Bool
(OutputsSpec -> OutputsSpec -> Bool)
-> (OutputsSpec -> OutputsSpec -> Bool) -> Eq OutputsSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputsSpec -> OutputsSpec -> Bool
== :: OutputsSpec -> OutputsSpec -> Bool
$c/= :: OutputsSpec -> OutputsSpec -> Bool
/= :: OutputsSpec -> OutputsSpec -> Bool
Eq, (forall x. OutputsSpec -> Rep OutputsSpec x)
-> (forall x. Rep OutputsSpec x -> OutputsSpec)
-> Generic OutputsSpec
forall x. Rep OutputsSpec x -> OutputsSpec
forall x. OutputsSpec -> Rep OutputsSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputsSpec -> Rep OutputsSpec x
from :: forall x. OutputsSpec -> Rep OutputsSpec x
$cto :: forall x. Rep OutputsSpec x -> OutputsSpec
to :: forall x. Rep OutputsSpec x -> OutputsSpec
Generic, Eq OutputsSpec
Eq OutputsSpec =>
(OutputsSpec -> OutputsSpec -> Ordering)
-> (OutputsSpec -> OutputsSpec -> Bool)
-> (OutputsSpec -> OutputsSpec -> Bool)
-> (OutputsSpec -> OutputsSpec -> Bool)
-> (OutputsSpec -> OutputsSpec -> Bool)
-> (OutputsSpec -> OutputsSpec -> OutputsSpec)
-> (OutputsSpec -> OutputsSpec -> OutputsSpec)
-> Ord OutputsSpec
OutputsSpec -> OutputsSpec -> Bool
OutputsSpec -> OutputsSpec -> Ordering
OutputsSpec -> OutputsSpec -> OutputsSpec
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
$ccompare :: OutputsSpec -> OutputsSpec -> Ordering
compare :: OutputsSpec -> OutputsSpec -> Ordering
$c< :: OutputsSpec -> OutputsSpec -> Bool
< :: OutputsSpec -> OutputsSpec -> Bool
$c<= :: OutputsSpec -> OutputsSpec -> Bool
<= :: OutputsSpec -> OutputsSpec -> Bool
$c> :: OutputsSpec -> OutputsSpec -> Bool
> :: OutputsSpec -> OutputsSpec -> Bool
$c>= :: OutputsSpec -> OutputsSpec -> Bool
>= :: OutputsSpec -> OutputsSpec -> Bool
$cmax :: OutputsSpec -> OutputsSpec -> OutputsSpec
max :: OutputsSpec -> OutputsSpec -> OutputsSpec
$cmin :: OutputsSpec -> OutputsSpec -> OutputsSpec
min :: OutputsSpec -> OutputsSpec -> OutputsSpec
Ord, Int -> OutputsSpec -> ShowS
[OutputsSpec] -> ShowS
OutputsSpec -> String
(Int -> OutputsSpec -> ShowS)
-> (OutputsSpec -> String)
-> ([OutputsSpec] -> ShowS)
-> Show OutputsSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputsSpec -> ShowS
showsPrec :: Int -> OutputsSpec -> ShowS
$cshow :: OutputsSpec -> String
show :: OutputsSpec -> String
$cshowList :: [OutputsSpec] -> ShowS
showList :: [OutputsSpec] -> ShowS
Show)

data DerivedPath =
    DerivedPath_Opaque StorePath
  -- ^ Fully evaluated store path that can't be built
  -- but can be fetched
  | DerivedPath_Built StorePath OutputsSpec
  -- ^ Derivation path and the outputs built from it
  deriving (DerivedPath -> DerivedPath -> Bool
(DerivedPath -> DerivedPath -> Bool)
-> (DerivedPath -> DerivedPath -> Bool) -> Eq DerivedPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivedPath -> DerivedPath -> Bool
== :: DerivedPath -> DerivedPath -> Bool
$c/= :: DerivedPath -> DerivedPath -> Bool
/= :: DerivedPath -> DerivedPath -> Bool
Eq, (forall x. DerivedPath -> Rep DerivedPath x)
-> (forall x. Rep DerivedPath x -> DerivedPath)
-> Generic DerivedPath
forall x. Rep DerivedPath x -> DerivedPath
forall x. DerivedPath -> Rep DerivedPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DerivedPath -> Rep DerivedPath x
from :: forall x. DerivedPath -> Rep DerivedPath x
$cto :: forall x. Rep DerivedPath x -> DerivedPath
to :: forall x. Rep DerivedPath x -> DerivedPath
Generic, Eq DerivedPath
Eq DerivedPath =>
(DerivedPath -> DerivedPath -> Ordering)
-> (DerivedPath -> DerivedPath -> Bool)
-> (DerivedPath -> DerivedPath -> Bool)
-> (DerivedPath -> DerivedPath -> Bool)
-> (DerivedPath -> DerivedPath -> Bool)
-> (DerivedPath -> DerivedPath -> DerivedPath)
-> (DerivedPath -> DerivedPath -> DerivedPath)
-> Ord DerivedPath
DerivedPath -> DerivedPath -> Bool
DerivedPath -> DerivedPath -> Ordering
DerivedPath -> DerivedPath -> DerivedPath
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
$ccompare :: DerivedPath -> DerivedPath -> Ordering
compare :: DerivedPath -> DerivedPath -> Ordering
$c< :: DerivedPath -> DerivedPath -> Bool
< :: DerivedPath -> DerivedPath -> Bool
$c<= :: DerivedPath -> DerivedPath -> Bool
<= :: DerivedPath -> DerivedPath -> Bool
$c> :: DerivedPath -> DerivedPath -> Bool
> :: DerivedPath -> DerivedPath -> Bool
$c>= :: DerivedPath -> DerivedPath -> Bool
>= :: DerivedPath -> DerivedPath -> Bool
$cmax :: DerivedPath -> DerivedPath -> DerivedPath
max :: DerivedPath -> DerivedPath -> DerivedPath
$cmin :: DerivedPath -> DerivedPath -> DerivedPath
min :: DerivedPath -> DerivedPath -> DerivedPath
Ord, Int -> DerivedPath -> ShowS
[DerivedPath] -> ShowS
DerivedPath -> String
(Int -> DerivedPath -> ShowS)
-> (DerivedPath -> String)
-> ([DerivedPath] -> ShowS)
-> Show DerivedPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivedPath -> ShowS
showsPrec :: Int -> DerivedPath -> ShowS
$cshow :: DerivedPath -> String
show :: DerivedPath -> String
$cshowList :: [DerivedPath] -> ShowS
showList :: [DerivedPath] -> ShowS
Show)

data ParseOutputsError =
    ParseOutputsError_InvalidPath InvalidPathError
  | ParseOutputsError_InvalidName InvalidNameError
  | ParseOutputsError_NoNames
  | ParseOutputsError_NoPrefix StoreDir Text
  deriving (ParseOutputsError -> ParseOutputsError -> Bool
(ParseOutputsError -> ParseOutputsError -> Bool)
-> (ParseOutputsError -> ParseOutputsError -> Bool)
-> Eq ParseOutputsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseOutputsError -> ParseOutputsError -> Bool
== :: ParseOutputsError -> ParseOutputsError -> Bool
$c/= :: ParseOutputsError -> ParseOutputsError -> Bool
/= :: ParseOutputsError -> ParseOutputsError -> Bool
Eq, Eq ParseOutputsError
Eq ParseOutputsError =>
(ParseOutputsError -> ParseOutputsError -> Ordering)
-> (ParseOutputsError -> ParseOutputsError -> Bool)
-> (ParseOutputsError -> ParseOutputsError -> Bool)
-> (ParseOutputsError -> ParseOutputsError -> Bool)
-> (ParseOutputsError -> ParseOutputsError -> Bool)
-> (ParseOutputsError -> ParseOutputsError -> ParseOutputsError)
-> (ParseOutputsError -> ParseOutputsError -> ParseOutputsError)
-> Ord ParseOutputsError
ParseOutputsError -> ParseOutputsError -> Bool
ParseOutputsError -> ParseOutputsError -> Ordering
ParseOutputsError -> ParseOutputsError -> ParseOutputsError
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
$ccompare :: ParseOutputsError -> ParseOutputsError -> Ordering
compare :: ParseOutputsError -> ParseOutputsError -> Ordering
$c< :: ParseOutputsError -> ParseOutputsError -> Bool
< :: ParseOutputsError -> ParseOutputsError -> Bool
$c<= :: ParseOutputsError -> ParseOutputsError -> Bool
<= :: ParseOutputsError -> ParseOutputsError -> Bool
$c> :: ParseOutputsError -> ParseOutputsError -> Bool
> :: ParseOutputsError -> ParseOutputsError -> Bool
$c>= :: ParseOutputsError -> ParseOutputsError -> Bool
>= :: ParseOutputsError -> ParseOutputsError -> Bool
$cmax :: ParseOutputsError -> ParseOutputsError -> ParseOutputsError
max :: ParseOutputsError -> ParseOutputsError -> ParseOutputsError
$cmin :: ParseOutputsError -> ParseOutputsError -> ParseOutputsError
min :: ParseOutputsError -> ParseOutputsError -> ParseOutputsError
Ord, Int -> ParseOutputsError -> ShowS
[ParseOutputsError] -> ShowS
ParseOutputsError -> String
(Int -> ParseOutputsError -> ShowS)
-> (ParseOutputsError -> String)
-> ([ParseOutputsError] -> ShowS)
-> Show ParseOutputsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseOutputsError -> ShowS
showsPrec :: Int -> ParseOutputsError -> ShowS
$cshow :: ParseOutputsError -> String
show :: ParseOutputsError -> String
$cshowList :: [ParseOutputsError] -> ShowS
showList :: [ParseOutputsError] -> ShowS
Show)

parseOutputsSpec :: Text -> Either ParseOutputsError OutputsSpec
parseOutputsSpec :: Text -> Either ParseOutputsError OutputsSpec
parseOutputsSpec Text
t
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" = OutputsSpec -> Either ParseOutputsError OutputsSpec
forall a b. b -> Either a b
Right OutputsSpec
OutputsSpec_All
  | Bool
otherwise = do
  [OutputName]
names <- (Text -> Either ParseOutputsError OutputName)
-> [Text] -> Either ParseOutputsError [OutputName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
             ( (InvalidNameError -> ParseOutputsError)
-> Either InvalidNameError OutputName
-> Either ParseOutputsError OutputName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
                 InvalidNameError -> ParseOutputsError
ParseOutputsError_InvalidName
             (Either InvalidNameError OutputName
 -> Either ParseOutputsError OutputName)
-> (Text -> Either InvalidNameError OutputName)
-> Text
-> Either ParseOutputsError OutputName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either InvalidNameError OutputName
System.Nix.OutputName.mkOutputName
             )
             (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Data.Text.splitOn Text
"," Text
t)
  if [OutputName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OutputName]
names
    then ParseOutputsError -> Either ParseOutputsError OutputsSpec
forall a b. a -> Either a b
Left ParseOutputsError
ParseOutputsError_NoNames
    else OutputsSpec -> Either ParseOutputsError OutputsSpec
forall a b. b -> Either a b
Right (OutputsSpec -> Either ParseOutputsError OutputsSpec)
-> OutputsSpec -> Either ParseOutputsError OutputsSpec
forall a b. (a -> b) -> a -> b
$ Set OutputName -> OutputsSpec
OutputsSpec_Names ([OutputName] -> Set OutputName
forall a. Ord a => [a] -> Set a
Data.Set.fromList [OutputName]
names)

outputsSpecToText :: OutputsSpec -> Text
outputsSpecToText :: OutputsSpec -> Text
outputsSpecToText = \case
  OutputsSpec
OutputsSpec_All -> Text
"*"
  OutputsSpec_Names Set OutputName
ns ->
    Text -> [Text] -> Text
Data.Text.intercalate
      Text
","
      ((OutputName -> Text) -> [OutputName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputName -> Text
System.Nix.OutputName.unOutputName
        (Set OutputName -> [OutputName]
forall a. Set a -> [a]
Data.Set.toList Set OutputName
ns)
      )

parseDerivedPath
  :: StoreDir
  -> Text
  -> Either ParseOutputsError DerivedPath
parseDerivedPath :: StoreDir -> Text -> Either ParseOutputsError DerivedPath
parseDerivedPath root :: StoreDir
root@(StoreDir RawFilePath
sd) Text
path =
  let -- We need to do a bit more legwork for case
      -- when StoreDir contains '!'
      -- which is generated by its Arbitrary instance
    textRoot :: Text
textRoot = String -> Text
Data.Text.pack
               (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ RawFilePath -> String
Data.ByteString.Char8.unpack RawFilePath
sd

  in case Text -> Text -> Maybe Text
Data.Text.stripPrefix Text
textRoot Text
path of
    Maybe Text
Nothing -> ParseOutputsError -> Either ParseOutputsError DerivedPath
forall a b. a -> Either a b
Left (ParseOutputsError -> Either ParseOutputsError DerivedPath)
-> ParseOutputsError -> Either ParseOutputsError DerivedPath
forall a b. (a -> b) -> a -> b
$ StoreDir -> Text -> ParseOutputsError
ParseOutputsError_NoPrefix StoreDir
root Text
path
    Just Text
woRoot ->
      case HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Data.Text.breakOn Text
"!" Text
woRoot of
        (Text
pathNoPrefix, Text
r) ->
          if Text -> Bool
Data.Text.null Text
r
          then StorePath -> DerivedPath
DerivedPath_Opaque
               (StorePath -> DerivedPath)
-> Either ParseOutputsError StorePath
-> Either ParseOutputsError DerivedPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either InvalidPathError StorePath
-> Either ParseOutputsError StorePath
forall a. Either InvalidPathError a -> Either ParseOutputsError a
convertError
                   (Either InvalidPathError StorePath
 -> Either ParseOutputsError StorePath)
-> Either InvalidPathError StorePath
-> Either ParseOutputsError StorePath
forall a b. (a -> b) -> a -> b
$ StoreDir -> Text -> Either InvalidPathError StorePath
System.Nix.StorePath.parsePathFromText
                      StoreDir
root
                      Text
path
                   )
          else StorePath -> OutputsSpec -> DerivedPath
DerivedPath_Built
               (StorePath -> OutputsSpec -> DerivedPath)
-> Either ParseOutputsError StorePath
-> Either ParseOutputsError (OutputsSpec -> DerivedPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either InvalidPathError StorePath
-> Either ParseOutputsError StorePath
forall a. Either InvalidPathError a -> Either ParseOutputsError a
convertError
                   (Either InvalidPathError StorePath
 -> Either ParseOutputsError StorePath)
-> Either InvalidPathError StorePath
-> Either ParseOutputsError StorePath
forall a b. (a -> b) -> a -> b
$ StoreDir -> Text -> Either InvalidPathError StorePath
System.Nix.StorePath.parsePathFromText
                       StoreDir
root
                       (Text
textRoot Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathNoPrefix)
                   )
               Either ParseOutputsError (OutputsSpec -> DerivedPath)
-> Either ParseOutputsError OutputsSpec
-> Either ParseOutputsError DerivedPath
forall a b.
Either ParseOutputsError (a -> b)
-> Either ParseOutputsError a -> Either ParseOutputsError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either ParseOutputsError OutputsSpec
parseOutputsSpec (Int -> Text -> Text
Data.Text.drop (Text -> Int
Data.Text.length Text
"!") Text
r)
  where
    convertError
      :: Either InvalidPathError a
      -> Either ParseOutputsError a
    convertError :: forall a. Either InvalidPathError a -> Either ParseOutputsError a
convertError = (InvalidPathError -> ParseOutputsError)
-> Either InvalidPathError a -> Either ParseOutputsError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first InvalidPathError -> ParseOutputsError
ParseOutputsError_InvalidPath

derivedPathToText :: StoreDir -> DerivedPath -> Text
derivedPathToText :: StoreDir -> DerivedPath -> Text
derivedPathToText StoreDir
root = \case
  DerivedPath_Opaque StorePath
p ->
    StoreDir -> StorePath -> Text
System.Nix.StorePath.storePathToText StoreDir
root StorePath
p
  DerivedPath_Built StorePath
p OutputsSpec
os ->
    StoreDir -> StorePath -> Text
System.Nix.StorePath.storePathToText StoreDir
root StorePath
p
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputsSpec -> Text
outputsSpecToText OutputsSpec
os