git.iko.soy/typeable/cabal2nix
on 9d40586 help sign in
typeable/cabal2nix/src/Distribution/Nixpkgs/Fetch.hs
160 lines 6.8 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE DeriveGeneric #-}
5module Distribution.Nixpkgs.Fetch
6 ( Source(..)
7 , Hash(..)
8 , DerivationSource(..), fromDerivationSource
9 , fetch
10 , fetchWith
11 ) where
13import Control.Applicative
14import Control.DeepSeq.Generics
15import Control.Monad
16import Control.Monad.IO.Class
17import Control.Monad.Trans.Maybe
18import GHC.Generics ( Generic )
19import System.Directory
20import System.Environment
21import System.Exit
22import System.IO
23import System.Process
25-- | A source is a location from which we can fetch, such as a HTTP URL, a GIT URL, ....
26data Source = Source
27 { sourceUrl :: String -- ^ URL to fetch from.
28 , sourceRevision :: String -- ^ Revision to use. For protocols where this doesn't make sense (such as HTTP), this
29 -- should be the empty string.
30 , sourceHash :: Hash -- ^ The expected hash of the source, if available.
31 } deriving (Show, Eq, Ord, Generic)
33instance NFData Source where rnf = genericRnf
35data Hash = Certain String | Guess String | UnknownHash
36 deriving (Show, Eq, Ord, Generic)
38instance NFData Hash where rnf = genericRnf
40isUnknown :: Hash -> Bool
41isUnknown UnknownHash = True
42isUnknown _ = False
44hashToList :: Hash -> [String]
45hashToList (Certain s) = [s]
46hashToList _ = []
48-- | A source for a derivation. It always needs a hash and also has a protocol attached to it (url, git, svn, ...).
49-- A @DerivationSource@ also always has it's revision fully resolved (not relative revisions like @master@, @HEAD@, etc).
50data DerivationSource = DerivationSource
51 { derivKind :: String -- ^ The kind of the source. The name of the build-support fetch derivation should be fetch<kind>.
52 , derivUrl :: String -- ^ URL to fetch from.
53 , derivRevision :: String -- ^ Revision to use. Leave empty if the fetcher doesn't support revisions.
54 , derivHash :: String -- ^ The hash of the source.
55 }
56 deriving (Show, Eq, Ord, Generic)
58instance NFData DerivationSource where rnf = genericRnf
60fromDerivationSource :: DerivationSource -> Source
61fromDerivationSource DerivationSource{..} = Source derivUrl derivRevision $ Certain derivHash
63-- | Fetch a source, trying any of the various nix-prefetch-* scripts.
64fetch :: forall a. (String -> MaybeT IO a) -- ^ This function is passed the output path name as an argument.
65 -- It should return 'Nothing' if the file doesn't match the expected format.
66 -- This is required, because we cannot always check if a download succeeded otherwise.
67 -> Source -- ^ The source to fetch from.
68 -> IO (Maybe (DerivationSource, a)) -- ^ The derivation source and the result of the processing function. Returns Nothing if the download failed.
69fetch f = runMaybeT . fetchers where
70 fetchers :: Source -> MaybeT IO (DerivationSource, a)
71 fetchers source = msum . (fetchLocal source :) $ map (\fetcher -> fetchWith fetcher source >>= process)
72 [ (False, "zip", [])
73 , (False, "url", [])
74 , (True, "git", ["--fetch-submodules"])
75 , (True, "hg", [])
76 , (True, "svn", [])
77 , (True, "bzr", [])
78 ]
80 -- | Remove '/' from the end of the path. Nix doesn't accept paths that
81 -- end in a slash.
82 stripSlashSuffix :: String -> String
83 stripSlashSuffix = reverse . dropWhile (== '/') . reverse
85 fetchLocal :: Source -> MaybeT IO (DerivationSource, a)
86 fetchLocal src = do
87 let path = stripSlashSuffix $ stripPrefix "file://" $ sourceUrl src
88 existsFile <- liftIO $ doesFileExist path
89 existsDir <- liftIO $ doesDirectoryExist path
90 guard $ existsDir || existsFile
91 let path' | '/' `elem` path = path
92 | otherwise = "./" ++ path
93 process (DerivationSource "" path' "" "", path') <|> localArchive path'
95 localArchive :: FilePath -> MaybeT IO (DerivationSource, a)
96 localArchive path = do
97 absolutePath <- liftIO $ canonicalizePath path
98 unpacked <- snd <$> fetchWith (False, "zip", []) (Source ("file://" ++ absolutePath) "" UnknownHash)
99 process (DerivationSource "" absolutePath "" "", unpacked)
101 process :: (DerivationSource, FilePath) -> MaybeT IO (DerivationSource, a)
102 process (derivSource, file) = (,) derivSource <$> f file
104-- | Like 'fetch', but allows to specify which script to use.
105fetchWith :: (Bool, String, [String]) -> Source -> MaybeT IO (DerivationSource, FilePath)
106fetchWith (supportsRev, kind, addArgs) source = do
107 unless ((sourceRevision source /= "") || isUnknown (sourceHash source) || not supportsRev) $
108 liftIO (hPutStrLn stderr "** need a revision for VCS when the hash is given. skipping.") >> mzero
110 MaybeT $ liftIO $ do
111 envs <- getEnvironment
112 (Nothing, Just stdoutH, _, processH) <- createProcess (proc script args)
113 { env = Just $ ("PRINT_PATH", "1") : envs
114 , std_in = Inherit
115 , std_err = Inherit
116 , std_out = CreatePipe
117 }
119 exitCode <- waitForProcess processH
120 case exitCode of
121 ExitSuccess -> fmap Just . processOutputSwitch . lines =<< hGetContents stdoutH
122 ExitFailure _ -> return Nothing
124 where
126 script :: String
127 script = "nix-prefetch-" ++ kind
129 args :: [String]
130 args = addArgs ++ sourceUrl source : [ sourceRevision source | supportsRev ] ++ hashToList (sourceHash source)
132 processOutputWithRev :: [String] -> IO (DerivationSource, FilePath)
133 processOutputWithRev [rev,hash,path] = return (DerivationSource kind (sourceUrl source) (extractRevision rev) hash, path)
134 processOutputWithRev [rev,_,hash,path] = processOutputWithRev [rev,hash,path]
135 processOutputWithRev out = unexpectedOutput out
137 extractRevision :: String -> String
138 extractRevision = unwords . drop 3 . words -- drop the "<vcs> revision is" prefix
140 processOutput :: [String] -> IO (DerivationSource, FilePath)
141 processOutput [hash,path] = return (DerivationSource kind (sourceUrl source) (sourceRevision source) hash, path)
142 processOutput out = unexpectedOutput out
144 unexpectedOutput :: [String] -> IO a
145 unexpectedOutput out = do
146 hPutStrLn stderr $ "*** unexpected output from " ++ "nix-prefetch-" ++ kind ++ " script: "
147 hPutStr stderr $ unlines out
148 exitFailure
150 processOutputSwitch :: [String] -> IO (DerivationSource, FilePath)
151 processOutputSwitch
152 | supportsRev && isUnknown (sourceHash source) = processOutputWithRev
153 | otherwise = processOutput
155stripPrefix :: Eq a => [a] -> [a] -> [a]
156stripPrefix prefix as
157 | prefix' == prefix = stripped
158 | otherwise = as
159 where
160 (prefix', stripped) = splitAt (length prefix) as