{- | Functions to download Haskell packages from Hackage. -} module Policeman.Download.Hackage ( PackageName (..) , downloadFromHackage , getLatestHackageCabalFileContent ) where import Control.Exception (catch) import Control.Monad.Trans.Except (withExceptT) import Shellmet (($?), ($|)) import System.Directory (createDirectoryIfMissing, getCurrentDirectory, removeDirectoryRecursive) import System.FilePath (()) import System.IO.Error (IOError, isDoesNotExistError) import Policeman.Core.Package (PackageName (..)) import Policeman.Core.Version (Version (versionText)) import Policeman.Download.Common (DownloadError (..), evidenceDir) {- | By the given pacakge name it downloads the latest `.cabal` file and returns its content. /.cabal> -} getLatestHackageCabalFileContent :: PackageName -> ExceptT DownloadError IO ByteString getLatestHackageCabalFileContent package@(PackageName packageName) = ExceptT $ (Right . encodeUtf8 <$> ("curl" $| ["--silent", url])) $? pure (Left $ NoSuchPackage package) where url :: Text url = mconcat [ hackageUrl , packageName , "/" , packageName , ".cabal" ] {- | This function takes 'PackageName' and previous package 'Version', downloads @.tar.gz@ archive from Hackage and unpacks it in the current directory. -} downloadFromHackage :: PackageName -> Version -> ExceptT DownloadError IO FilePath downloadFromHackage packageName@(PackageName name) (versionText -> version) = do let fullName = name <> "-" <> version let tarName = fullName <> ".tar.gz" let tarUrl = mconcat [ hackageUrl , name , "/" , tarName ] let tarPath = toText $ evidenceDir toString tarName let srcPath = evidenceDir toString fullName liftIO $ createDirectoryIfMissing True evidenceDir withExceptT SystemError $ removeDirIfExists srcPath -- download archive from Hackage ExceptT $ (Right <$> "curl" ["--silent", tarUrl, "--output", tarPath]) $? pure (Left $ NoSuchPackage packageName) -- unpack liftIO $ "tar" ["-xf", tarPath, "-C", toText evidenceDir] liftIO $ fmap ( srcPath) getCurrentDirectory hackageUrl :: Text hackageUrl = "http://hackage.haskell.org/package/" removeDirIfExists :: FilePath -> ExceptT IOError IO () removeDirIfExists fileName = ExceptT $ (Right <$> removeDirectoryRecursive fileName) `catch` (pure . handleExists) where handleExists :: IOError -> Either IOError () handleExists e | isDoesNotExistError e = Right () | otherwise = Left e