{-# 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

-- | A source is a location from which we can fetch, such as a HTTP URL, a GIT URL, ....
data Source = Source
  { Source -> String
sourceUrl       :: String       -- ^ URL to fetch from.
  , Source -> String
sourceRevision  :: String       -- ^ Revision to use. For protocols where this doesn't make sense (such as HTTP), this
                                    --   should be the empty string.
  , Source -> Hash
sourceHash      :: Hash         -- ^ The expected hash of the source, if available.
  , Source -> String
sourceCabalDir  :: String       -- ^ Directory where Cabal file is found.
  } 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
_           = []

-- | A source for a derivation. It always needs a hash and also has a protocol attached to it (url, git, svn, ...).
-- A @DerivationSource@ also always has it's revision fully resolved (not relative revisions like @master@, @HEAD@, etc).
data DerivationSource = DerivationSource
  { DerivationSource -> Maybe DerivKind
derivKind     :: Maybe DerivKind -- ^ The kind of the source. If Nothing, it is a local derivation.
  , DerivationSource -> String
derivUrl      :: String -- ^ URL to fetch from.
  , DerivationSource -> String
derivRevision :: String -- ^ Revision to use. Leave empty if the fetcher doesn't support revisions.
  , DerivationSource -> String
derivHash     :: String -- ^ The hash of the source.
  , DerivationSource -> Maybe Bool
derivSubmodule :: Maybe Bool -- ^ The fetchSubmodule setting (if any)
  }
  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 a source, trying any of the various nix-prefetch-* scripts.
fetch :: forall a.
         FetchSubmodules
      -- ^ whether to fetch submodules when the source is a git repository
      -> (String -> MaybeT IO a)
      -- ^ This function is passed the output path name as an argument.
      -- It should return 'Nothing' if the file doesn't match the expected format.
      -- This is required, because we cannot always check if a download succeeded otherwise.
      -> Source
      -- ^ The source to fetch from.
      -> IO (Maybe (DerivationSource, a))
      -- ^ The derivation source and the result of the processing function. Returns Nothing if the download failed.
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)
    ]

  -- | Remove '/' from the end of the path. Nix doesn't accept paths that
  -- end in a slash.
  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

-- | Whether to fetch submodules (git).
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


-- | Whether to unpack an archive after fetching, before putting it into the nix store.
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


-- | The nixpkgs function to use for fetching this kind of derivation
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"


-- | Like 'fetch', but allows to specify which script to use.
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