{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module Distribution.Nixpkgs.Fetch
( Source(..)
, Hash(..)
, DerivationSource(..), fromDerivationSource, urlDerivationSource
, DerivKind(..)
, derivKindFunction
, FetchSubmodules(..)
, UnpackArchive(..)
, fetch
, fetchWith
) where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as L
import Data.Maybe
import GHC.Generics ( Generic )
import Language.Nix.PrettyPrinting as PP
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.Process
data Source = Source
{ Source -> String
sourceUrl :: String
, Source -> String
sourceRevision :: String
, Source -> Hash
sourceHash :: Hash
, Source -> String
sourceCabalDir :: String
} deriving (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, Source -> Source -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, Eq Source
Source -> Source -> Bool
Source -> Source -> Ordering
Source -> Source -> Source
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Source -> Source -> Source
$cmin :: Source -> Source -> Source
max :: Source -> Source -> Source
$cmax :: Source -> Source -> Source
>= :: Source -> Source -> Bool
$c>= :: Source -> Source -> Bool
> :: Source -> Source -> Bool
$c> :: Source -> Source -> Bool
<= :: Source -> Source -> Bool
$c<= :: Source -> Source -> Bool
< :: Source -> Source -> Bool
$c< :: Source -> Source -> Bool
compare :: Source -> Source -> Ordering
$ccompare :: Source -> Source -> Ordering
Ord, forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic)
instance NFData Source
data Hash = Certain String | Guess String | UnknownHash
deriving (Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show, Hash -> Hash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c== :: Hash -> Hash -> Bool
Eq, Eq Hash
Hash -> Hash -> Bool
Hash -> Hash -> Ordering
Hash -> Hash -> Hash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hash -> Hash -> Hash
$cmin :: Hash -> Hash -> Hash
max :: Hash -> Hash -> Hash
$cmax :: Hash -> Hash -> Hash
>= :: Hash -> Hash -> Bool
$c>= :: Hash -> Hash -> Bool
> :: Hash -> Hash -> Bool
$c> :: Hash -> Hash -> Bool
<= :: Hash -> Hash -> Bool
$c<= :: Hash -> Hash -> Bool
< :: Hash -> Hash -> Bool
$c< :: Hash -> Hash -> Bool
compare :: Hash -> Hash -> Ordering
$ccompare :: Hash -> Hash -> Ordering
Ord, forall x. Rep Hash x -> Hash
forall x. Hash -> Rep Hash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hash x -> Hash
$cfrom :: forall x. Hash -> Rep Hash x
Generic)
instance NFData Hash
isUnknown :: Hash -> Bool
isUnknown :: Hash -> Bool
isUnknown Hash
UnknownHash = Bool
True
isUnknown Hash
_ = Bool
False
hashToList :: Hash -> [String]
hashToList :: Hash -> [String]
hashToList (Certain String
s) = [String
s]
hashToList Hash
_ = []
data DerivationSource = DerivationSource
{ DerivationSource -> Maybe DerivKind
derivKind :: Maybe DerivKind
, DerivationSource -> String
derivUrl :: String
, DerivationSource -> String
derivRevision :: String
, DerivationSource -> String
derivHash :: String
, DerivationSource -> Maybe Bool
derivSubmodule :: Maybe Bool
}
deriving (Int -> DerivationSource -> ShowS
[DerivationSource] -> ShowS
DerivationSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationSource] -> ShowS
$cshowList :: [DerivationSource] -> ShowS
show :: DerivationSource -> String
$cshow :: DerivationSource -> String
showsPrec :: Int -> DerivationSource -> ShowS
$cshowsPrec :: Int -> DerivationSource -> ShowS
Show, forall x. Rep DerivationSource x -> DerivationSource
forall x. DerivationSource -> Rep DerivationSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivationSource x -> DerivationSource
$cfrom :: forall x. DerivationSource -> Rep DerivationSource x
Generic)
instance NFData DerivationSource
instance FromJSON DerivationSource where
parseJSON :: Value -> Parser DerivationSource
parseJSON (Object Object
o) = Maybe DerivKind
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource (forall a. HasCallStack => String -> a
error String
"undefined DerivationSource.kind")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rev"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha256"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetchSubmodules"
parseJSON Value
_ = forall a. HasCallStack => String -> a
error String
"invalid DerivationSource"
instance PP.Pretty DerivationSource where
pPrint :: DerivationSource -> Doc
pPrint DerivationSource {String
Maybe Bool
Maybe DerivKind
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: Maybe DerivKind
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> Maybe DerivKind
..} =
let isHackagePackage :: Bool
isHackagePackage = String
"mirror://hackage/" forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
derivUrl
in if Bool
isHackagePackage then if String
derivHash forall a. Eq a => a -> a -> Bool
/= String
"" then String -> Doc -> Doc
attr String
"sha256" forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash else forall a. Monoid a => a
mempty
else case Maybe DerivKind
derivKind of
Maybe DerivKind
Nothing -> String -> Doc -> Doc
attr String
"src" forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
derivUrl
Just DerivKind
derivKind' -> [Doc] -> Doc
vcat
[ String -> Doc
text String
"src" Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> String -> Doc
text (DerivKind -> String
derivKindFunction DerivKind
derivKind') Doc -> Doc -> Doc
<+> Doc
lbrace
, Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
[ String -> Doc -> Doc
attr String
"url" forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivUrl
, String -> Doc -> Doc
attr String
"sha256" forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash
, if String
derivRevision forall a. Eq a => a -> a -> Bool
/= String
"" then String -> Doc -> Doc
attr String
"rev" (String -> Doc
string String
derivRevision) else Doc
PP.empty
, String -> Bool -> Bool -> Doc
boolattr String
"fetchSubmodules" (forall a. Maybe a -> Bool
isJust Maybe Bool
derivSubmodule) (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Bool
derivSubmodule)
]
, Doc
rbrace Doc -> Doc -> Doc
PP.<> Doc
semi
]
urlDerivationSource :: String -> String -> DerivationSource
urlDerivationSource :: String -> String -> DerivationSource
urlDerivationSource String
url String
hash =
DerivationSource {
derivKind :: Maybe DerivKind
derivKind = forall a. a -> Maybe a
Just (UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
DontUnpackArchive),
derivUrl :: String
derivUrl = String
url,
derivRevision :: String
derivRevision = String
"",
derivHash :: String
derivHash = String
hash,
derivSubmodule :: Maybe Bool
derivSubmodule = forall a. Maybe a
Nothing
}
fromDerivationSource :: DerivationSource -> Source
fromDerivationSource :: DerivationSource -> Source
fromDerivationSource DerivationSource{String
Maybe Bool
Maybe DerivKind
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: Maybe DerivKind
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> Maybe DerivKind
..} =
Source {
sourceUrl :: String
sourceUrl = String
derivUrl,
sourceRevision :: String
sourceRevision = String
derivRevision,
sourceHash :: Hash
sourceHash = String -> Hash
Certain String
derivHash,
sourceCabalDir :: String
sourceCabalDir = String
"."
}
fetch :: forall a.
FetchSubmodules
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch :: forall a.
FetchSubmodules
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch FetchSubmodules
optSubModules String -> MaybeT IO a
f = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> MaybeT IO (DerivationSource, a)
fetchers where
fetchers :: Source -> MaybeT IO (DerivationSource, a)
fetchers :: Source -> MaybeT IO (DerivationSource, a)
fetchers Source
source = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source -> MaybeT IO (DerivationSource, a)
fetchLocal Source
source forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Bool, DerivKind)
fetcher -> (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool, DerivKind)
fetcher Source
source forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process)
[ (Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
DontUnpackArchive)
, (Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
UnpackArchive)
, (Bool
True, FetchSubmodules -> DerivKind
DerivKindGit FetchSubmodules
optSubModules)
, (Bool
True, DerivKind
DerivKindHg)
, (Bool
True, DerivKind
DerivKindSvn)
, (Bool
True, DerivKind
DerivKindBzr)
]
stripSlashSuffix :: String -> String
stripSlashSuffix :: ShowS
stripSlashSuffix = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
fetchLocal :: Source -> MaybeT IO (DerivationSource, a)
fetchLocal :: Source -> MaybeT IO (DerivationSource, a)
fetchLocal Source
src = do
let path :: String
path = ShowS
stripSlashSuffix forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
stripPrefix String
"file://" forall a b. (a -> b) -> a -> b
$ Source -> String
sourceUrl Source
src
Bool
existsFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path
Bool
existsDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
path
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
existsDir Bool -> Bool -> Bool
|| Bool
existsFile
let path' :: String
path' | Char
'/' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
path = String
path
| Bool
otherwise = String
"./" forall a. [a] -> [a] -> [a]
++ String
path
(DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (String -> DerivationSource
localDerivationSource String
path', String
path') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> MaybeT IO (DerivationSource, a)
localArchive String
path'
localArchive :: FilePath -> MaybeT IO (DerivationSource, a)
localArchive :: String -> MaybeT IO (DerivationSource, a)
localArchive String
path = do
String
absolutePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
path
String
unpacked <-
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith
(Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
UnpackArchive)
(Source {
sourceUrl :: String
sourceUrl = String
"file://" forall a. [a] -> [a] -> [a]
++ String
absolutePath,
sourceRevision :: String
sourceRevision = String
"",
sourceHash :: Hash
sourceHash = Hash
UnknownHash,
sourceCabalDir :: String
sourceCabalDir = String
"."
})
(DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (String -> DerivationSource
localDerivationSource String
absolutePath, String
unpacked)
process :: (DerivationSource, FilePath) -> MaybeT IO (DerivationSource, a)
process :: (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (DerivationSource
derivSource, String
file) = (,) DerivationSource
derivSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> MaybeT IO a
f String
file
localDerivationSource :: String -> DerivationSource
localDerivationSource String
p =
DerivationSource {
derivKind :: Maybe DerivKind
derivKind = forall a. Maybe a
Nothing,
derivUrl :: String
derivUrl = String
p,
derivRevision :: String
derivRevision = String
"",
derivHash :: String
derivHash = String
"",
derivSubmodule :: Maybe Bool
derivSubmodule = forall a. Maybe a
Nothing
}
data DerivKind
= DerivKindUrl UnpackArchive
| DerivKindGit FetchSubmodules
| DerivKindHg
| DerivKindSvn
| DerivKindBzr
deriving (Int -> DerivKind -> ShowS
[DerivKind] -> ShowS
DerivKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivKind] -> ShowS
$cshowList :: [DerivKind] -> ShowS
show :: DerivKind -> String
$cshow :: DerivKind -> String
showsPrec :: Int -> DerivKind -> ShowS
$cshowsPrec :: Int -> DerivKind -> ShowS
Show, forall x. Rep DerivKind x -> DerivKind
forall x. DerivKind -> Rep DerivKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivKind x -> DerivKind
$cfrom :: forall x. DerivKind -> Rep DerivKind x
Generic)
instance NFData DerivKind
data FetchSubmodules = FetchSubmodules | DontFetchSubmodules
deriving (Int -> FetchSubmodules -> ShowS
[FetchSubmodules] -> ShowS
FetchSubmodules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchSubmodules] -> ShowS
$cshowList :: [FetchSubmodules] -> ShowS
show :: FetchSubmodules -> String
$cshow :: FetchSubmodules -> String
showsPrec :: Int -> FetchSubmodules -> ShowS
$cshowsPrec :: Int -> FetchSubmodules -> ShowS
Show, forall x. Rep FetchSubmodules x -> FetchSubmodules
forall x. FetchSubmodules -> Rep FetchSubmodules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FetchSubmodules x -> FetchSubmodules
$cfrom :: forall x. FetchSubmodules -> Rep FetchSubmodules x
Generic)
instance NFData FetchSubmodules
data UnpackArchive = UnpackArchive | DontUnpackArchive
deriving (Int -> UnpackArchive -> ShowS
[UnpackArchive] -> ShowS
UnpackArchive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnpackArchive] -> ShowS
$cshowList :: [UnpackArchive] -> ShowS
show :: UnpackArchive -> String
$cshow :: UnpackArchive -> String
showsPrec :: Int -> UnpackArchive -> ShowS
$cshowsPrec :: Int -> UnpackArchive -> ShowS
Show, forall x. Rep UnpackArchive x -> UnpackArchive
forall x. UnpackArchive -> Rep UnpackArchive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnpackArchive x -> UnpackArchive
$cfrom :: forall x. UnpackArchive -> Rep UnpackArchive x
Generic)
instance NFData UnpackArchive
derivKindFunction :: DerivKind -> String
derivKindFunction :: DerivKind -> String
derivKindFunction = \case
DerivKindUrl UnpackArchive
DontUnpackArchive -> String
"fetchurl"
DerivKindUrl UnpackArchive
UnpackArchive -> String
"fetchzip"
DerivKindGit FetchSubmodules
_ -> String
"fetchgit"
DerivKind
DerivKindHg -> String
"fetchhg"
DerivKind
DerivKindSvn -> String
"fetchsvn"
DerivKind
DerivKindBzr -> String
"fetchbzr"
fetchWith :: (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, FilePath)
fetchWith :: (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool
supportsRev, DerivKind
kind) Source
source = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Source -> String
sourceRevision Source
source forall a. Eq a => a -> a -> Bool
/= String
"") Bool -> Bool -> Bool
|| Hash -> Bool
isUnknown (Source -> Hash
sourceHash Source
source) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
supportsRev) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"** need a revision for VCS when the hash is given. skipping.") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a
mzero
let (String
script, [String]
extraArgs) = case DerivKind
kind of
DerivKindUrl UnpackArchive
UnpackArchive -> (String
"nix-prefetch-url", [String
"--unpack"])
DerivKindUrl UnpackArchive
DontUnpackArchive -> (String
"nix-prefetch-url", [])
DerivKindGit FetchSubmodules
FetchSubmodules -> (String
"nix-prefetch-git", [String
"--fetch-submodules"])
DerivKindGit FetchSubmodules
DontFetchSubmodules -> (String
"nix-prefetch-git", [])
DerivKind
DerivKindHg -> (String
"nix-prefetch-hg", [])
DerivKind
DerivKindSvn -> (String
"nix-prefetch-svn", [])
DerivKind
DerivKindBzr -> (String
"nix-prefetch-bzr", [])
let [String]
args :: [String] =
[String]
extraArgs
forall a. [a] -> [a] -> [a]
++ Source -> String
sourceUrl Source
source
forall a. a -> [a] -> [a]
: [ Source -> String
sourceRevision Source
source | Bool
supportsRev ]
forall a. [a] -> [a] -> [a]
++ Hash -> [String]
hashToList (Source -> Hash
sourceHash Source
source)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[(String, String)]
envs <- IO [(String, String)]
getEnvironment
(Maybe Handle
Nothing, Just Handle
stdoutH, Maybe Handle
_, ProcessHandle
processH) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
(String -> [String] -> CreateProcess
proc String
script [String]
args)
{ env :: Maybe [(String, String)]
env = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (String
"PRINT_PATH", String
"1") forall a. a -> [a] -> [a]
: [(String, String)]
envs
, std_in :: StdStream
std_in = StdStream
Inherit
, std_err :: StdStream
std_err = StdStream
Inherit
, std_out :: StdStream
std_out = StdStream
CreatePipe
}
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processH
case ExitCode
exitCode of
ExitFailure Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
ExitCode
ExitSuccess -> do
ByteString
buf <- Handle -> IO ByteString
BS.hGetContents Handle
stdoutH
let (ByteString
l,[ByteString]
ls) = case forall a. [a] -> [a]
reverse (ByteString -> [ByteString]
BS.lines ByteString
buf) of
[] -> forall a. HasCallStack => String -> a
error String
"This can't happen, but GHC doesn't know that."
(ByteString
x:[ByteString]
xs) -> (ByteString
x,[ByteString]
xs)
buf' :: ByteString
buf' = [ByteString] -> ByteString
BS.unlines (forall a. [a] -> [a]
reverse [ByteString]
ls)
case forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ls of
Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (DerivationSource { derivKind :: Maybe DerivKind
derivKind = forall a. a -> Maybe a
Just DerivKind
kind
, derivUrl :: String
derivUrl = Source -> String
sourceUrl Source
source
, derivRevision :: String
derivRevision = String
""
, derivHash :: String
derivHash = ByteString -> String
BS.unpack (forall a. [a] -> a
head [ByteString]
ls)
, derivSubmodule :: Maybe Bool
derivSubmodule = forall a. Maybe a
Nothing
}
, ByteString -> String
BS.unpack ByteString
l))
Int
_ -> case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
buf' of
Left String
err -> forall a. HasCallStack => String -> a
error (String
"invalid JSON: " forall a. [a] -> [a] -> [a]
++ String
err forall a. [a] -> [a] -> [a]
++ String
" in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteString
buf')
Right DerivationSource
ds -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (DerivationSource
ds { derivKind :: Maybe DerivKind
derivKind = forall a. a -> Maybe a
Just DerivKind
kind }, ByteString -> String
BS.unpack ByteString
l))
stripPrefix :: Eq a => [a] -> [a] -> [a]
stripPrefix :: forall a. Eq a => [a] -> [a] -> [a]
stripPrefix [a]
prefix [a]
as
| [a]
prefix' forall a. Eq a => a -> a -> Bool
== [a]
prefix = [a]
stripped
| Bool
otherwise = [a]
as
where
([a]
prefix', [a]
stripped) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
prefix) [a]
as