{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Nixpkgs.Fetch
  ( Source(..)
  , Hash(..)
  , DerivationSource(..), fromDerivationSource, urlDerivationSource
  , 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
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
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
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
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
Eq Source
-> (Source -> Source -> Ordering)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Source)
-> (Source -> Source -> Source)
-> Ord 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
$cp1Ord :: Eq Source
Ord, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
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
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
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
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
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
Eq Hash
-> (Hash -> Hash -> Ordering)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Hash)
-> (Hash -> Hash -> Hash)
-> Ord 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
$cp1Ord :: Eq Hash
Ord, (forall x. Hash -> Rep Hash x)
-> (forall x. Rep Hash x -> Hash) -> Generic Hash
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 -> String
derivKind     :: String -- ^ The kind of the source. The name of the build-support fetch derivation should be fetch<kind>.
  , 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
(Int -> DerivationSource -> ShowS)
-> (DerivationSource -> String)
-> ([DerivationSource] -> ShowS)
-> Show DerivationSource
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, DerivationSource -> DerivationSource -> Bool
(DerivationSource -> DerivationSource -> Bool)
-> (DerivationSource -> DerivationSource -> Bool)
-> Eq DerivationSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivationSource -> DerivationSource -> Bool
$c/= :: DerivationSource -> DerivationSource -> Bool
== :: DerivationSource -> DerivationSource -> Bool
$c== :: DerivationSource -> DerivationSource -> Bool
Eq, Eq DerivationSource
Eq DerivationSource
-> (DerivationSource -> DerivationSource -> Ordering)
-> (DerivationSource -> DerivationSource -> Bool)
-> (DerivationSource -> DerivationSource -> Bool)
-> (DerivationSource -> DerivationSource -> Bool)
-> (DerivationSource -> DerivationSource -> Bool)
-> (DerivationSource -> DerivationSource -> DerivationSource)
-> (DerivationSource -> DerivationSource -> DerivationSource)
-> Ord DerivationSource
DerivationSource -> DerivationSource -> Bool
DerivationSource -> DerivationSource -> Ordering
DerivationSource -> DerivationSource -> DerivationSource
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 :: DerivationSource -> DerivationSource -> DerivationSource
$cmin :: DerivationSource -> DerivationSource -> DerivationSource
max :: DerivationSource -> DerivationSource -> DerivationSource
$cmax :: DerivationSource -> DerivationSource -> DerivationSource
>= :: DerivationSource -> DerivationSource -> Bool
$c>= :: DerivationSource -> DerivationSource -> Bool
> :: DerivationSource -> DerivationSource -> Bool
$c> :: DerivationSource -> DerivationSource -> Bool
<= :: DerivationSource -> DerivationSource -> Bool
$c<= :: DerivationSource -> DerivationSource -> Bool
< :: DerivationSource -> DerivationSource -> Bool
$c< :: DerivationSource -> DerivationSource -> Bool
compare :: DerivationSource -> DerivationSource -> Ordering
$ccompare :: DerivationSource -> DerivationSource -> Ordering
$cp1Ord :: Eq DerivationSource
Ord, (forall x. DerivationSource -> Rep DerivationSource x)
-> (forall x. Rep DerivationSource x -> DerivationSource)
-> Generic DerivationSource
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) = String
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource (ShowS
forall a. HasCallStack => String -> a
error String
"undefined DerivationSource.kind")
        (String -> String -> String -> Maybe Bool -> DerivationSource)
-> Parser String
-> Parser (String -> String -> Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
        Parser (String -> String -> Maybe Bool -> DerivationSource)
-> Parser String
-> Parser (String -> Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rev"
        Parser (String -> Maybe Bool -> DerivationSource)
-> Parser String -> Parser (Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sha256"
        Parser (Maybe Bool -> DerivationSource)
-> Parser (Maybe Bool) -> Parser DerivationSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"fetchSubmodules"
  parseJSON Value
_ = String -> Parser DerivationSource
forall a. HasCallStack => String -> a
error String
"invalid DerivationSource"

instance PP.Pretty DerivationSource where
  pPrint :: DerivationSource -> Doc
pPrint DerivationSource {String
Maybe Bool
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: String
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> String
..} =
    let isHackagePackage :: Bool
isHackagePackage = String
"mirror://hackage/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
derivUrl
        fetched :: Bool
fetched = String
derivKind String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""
    in if Bool
isHackagePackage then if String
derivHash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then String -> Doc -> Doc
attr String
"sha256" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash else Doc
forall a. Monoid a => a
mempty
       else if Bool -> Bool
not Bool
fetched then String -> Doc -> Doc
attr String
"src" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
derivUrl
            else [Doc] -> Doc
vcat
                 [ String -> Doc
text String
"src" Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> String -> Doc
text (String
"fetch" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
derivKind) Doc -> Doc -> Doc
<+> Doc
lbrace
                 , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
                   [ String -> Doc -> Doc
attr String
"url" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivUrl
                   , String -> Doc -> Doc
attr String
"sha256" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash
                   , if String
derivRevision String -> String -> Bool
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" (Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
derivSubmodule) (Maybe Bool -> Bool
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 = String
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource String
"url" String
url String
"" String
hash Maybe Bool
forall a. Maybe a
Nothing

fromDerivationSource :: DerivationSource -> Source
fromDerivationSource :: DerivationSource -> Source
fromDerivationSource DerivationSource{String
Maybe Bool
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: String
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> String
..} = String -> String -> Hash -> String -> Source
Source String
derivUrl String
derivRevision (String -> Hash
Certain String
derivHash) String
"."

-- | Fetch a source, trying any of the various nix-prefetch-* scripts.
fetch :: forall a.
         Bool                                   -- ^ If True, 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 :: Bool
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch Bool
optSubModules String -> MaybeT IO a
f = MaybeT IO (DerivationSource, a) -> IO (Maybe (DerivationSource, a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (DerivationSource, a)
 -> IO (Maybe (DerivationSource, a)))
-> (Source -> MaybeT IO (DerivationSource, a))
-> Source
-> IO (Maybe (DerivationSource, a))
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 = [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO (DerivationSource, a)]
 -> MaybeT IO (DerivationSource, a))
-> ([MaybeT IO (DerivationSource, a)]
    -> [MaybeT IO (DerivationSource, a)])
-> [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source -> MaybeT IO (DerivationSource, a)
fetchLocal Source
source MaybeT IO (DerivationSource, a)
-> [MaybeT IO (DerivationSource, a)]
-> [MaybeT IO (DerivationSource, a)]
forall a. a -> [a] -> [a]
:) ([MaybeT IO (DerivationSource, a)]
 -> MaybeT IO (DerivationSource, a))
-> [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall a b. (a -> b) -> a -> b
$ ((Bool, String, Maybe String, [String])
 -> MaybeT IO (DerivationSource, a))
-> [(Bool, String, Maybe String, [String])]
-> [MaybeT IO (DerivationSource, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool, String, Maybe String, [String])
fetcher -> (Bool, String, Maybe String, [String])
-> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool, String, Maybe String, [String])
fetcher Source
source MaybeT IO (DerivationSource, String)
-> ((DerivationSource, String) -> MaybeT IO (DerivationSource, a))
-> MaybeT IO (DerivationSource, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process)
    [ (Bool
False, String
"url", Maybe String
forall a. Maybe a
Nothing, [])
    , (Bool
False, String
"zip", String -> Maybe String
forall a. a -> Maybe a
Just String
"nix-prefetch-url", [String
"--unpack"])
    , (Bool
True, String
"git", Maybe String
forall a. Maybe a
Nothing, [String
"--fetch-submodules" | Bool
optSubModules ])
    , (Bool
True, String
"hg", Maybe String
forall a. Maybe a
Nothing, [])
    , (Bool
True, String
"svn", Maybe String
forall a. Maybe a
Nothing, [])
    , (Bool
True, String
"bzr", Maybe String
forall a. Maybe a
Nothing, [])
    ]

  -- | Remove '/' from the end of the path. Nix doesn't accept paths that
  -- end in a slash.
  stripSlashSuffix :: String -> String
  stripSlashSuffix :: ShowS
stripSlashSuffix = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
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 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
stripPrefix String
"file://" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Source -> String
sourceUrl Source
src
    Bool
existsFile <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path
    Bool
existsDir  <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
path
    Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Bool
existsDir Bool -> Bool -> Bool
|| Bool
existsFile
    let path' :: String
path' | Char
'/' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
path = String
path
              | Bool
otherwise       = String
"./" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (String -> DerivationSource
localDerivationSource String
path', String
path') MaybeT IO (DerivationSource, a)
-> MaybeT IO (DerivationSource, a)
-> MaybeT IO (DerivationSource, a)
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 <- IO String -> MaybeT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
path
    String
unpacked <- (DerivationSource, String) -> String
forall a b. (a, b) -> b
snd ((DerivationSource, String) -> String)
-> MaybeT IO (DerivationSource, String) -> MaybeT IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool, String, Maybe String, [String])
-> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool
False, String
"url", Maybe String
forall a. Maybe a
Nothing, [String
"--unpack"]) (String -> String -> Hash -> String -> Source
Source (String
"file://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
absolutePath) String
"" Hash
UnknownHash 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 (a -> (DerivationSource, a))
-> MaybeT IO a -> MaybeT IO (DerivationSource, a)
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 = String
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource String
"" String
p String
"" String
"" Maybe Bool
forall a. Maybe a
Nothing

-- | Like 'fetch', but allows to specify which script to use.
fetchWith :: (Bool, String, Maybe String, [String]) -> Source -> MaybeT IO (DerivationSource, FilePath)
fetchWith :: (Bool, String, Maybe String, [String])
-> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool
supportsRev, String
kind, Maybe String
command, [String]
addArgs) Source
source = do
  Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Source -> String
sourceRevision Source
source String -> String -> Bool
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) (MaybeT IO () -> MaybeT IO ()) -> MaybeT IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$
    IO () -> MaybeT IO ()
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.") MaybeT IO () -> MaybeT IO () -> MaybeT IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaybeT IO ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

  IO (Maybe (DerivationSource, String))
-> MaybeT IO (DerivationSource, String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (DerivationSource, String))
 -> MaybeT IO (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
-> MaybeT IO (DerivationSource, String)
forall a b. (a -> b) -> a -> b
$ IO (Maybe (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (DerivationSource, String))
 -> IO (Maybe (DerivationSource, String)))
-> IO (Maybe (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
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 = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String
"PRINT_PATH", String
"1") (String, String) -> [(String, String)] -> [(String, String)]
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
_ -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DerivationSource, String)
forall a. Maybe a
Nothing
      ExitCode
ExitSuccess   -> do
        ByteString
buf <- Handle -> IO ByteString
BS.hGetContents Handle
stdoutH
        let (ByteString
l,[ByteString]
ls) = case [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString -> [ByteString]
BS.lines ByteString
buf) of
                       []     -> String -> (ByteString, [ByteString])
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 ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
ls)
        case [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ls of
          Int
0 -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DerivationSource, String)
forall a. Maybe a
Nothing
          Int
1 -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((DerivationSource, String) -> Maybe (DerivationSource, String)
forall a. a -> Maybe a
Just (DerivationSource :: String
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource { derivKind :: String
derivKind = String
kind
                                              , derivUrl :: String
derivUrl = Source -> String
sourceUrl Source
source
                                              , derivRevision :: String
derivRevision = String
""
                                              , derivHash :: String
derivHash = ByteString -> String
BS.unpack ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
ls)
                                              , derivSubmodule :: Maybe Bool
derivSubmodule = Maybe Bool
forall a. Maybe a
Nothing
                                              }
                            , ByteString -> String
BS.unpack ByteString
l))
          Int
_ -> case ByteString -> Either String DerivationSource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
buf' of
                 Left String
err -> String -> IO (Maybe (DerivationSource, String))
forall a. HasCallStack => String -> a
error (String
"invalid JSON: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
buf')
                 Right DerivationSource
ds -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((DerivationSource, String) -> Maybe (DerivationSource, String)
forall a. a -> Maybe a
Just (DerivationSource
ds { derivKind :: String
derivKind = String
kind }, ByteString -> String
BS.unpack ByteString
l))
 where

   script :: String
   script :: String
script = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"nix-prefetch-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
kind) Maybe String
command

   args :: [String]
   args :: [String]
args = [String]
addArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Source -> String
sourceUrl Source
source String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ Source -> String
sourceRevision Source
source | Bool
supportsRev ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Hash -> [String]
hashToList (Source -> Hash
sourceHash Source
source)

stripPrefix :: Eq a => [a] -> [a] -> [a]
stripPrefix :: [a] -> [a] -> [a]
stripPrefix [a]
prefix [a]
as
  | [a]
prefix' [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
prefix = [a]
stripped
  | Bool
otherwise = [a]
as
 where
  ([a]
prefix', [a]
stripped) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
prefix) [a]
as