{- |
   Module      :  Distribution.Hackage.DB.Path
   License     :  BSD3
   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  portable

   Find the location of the local Hackage database that is maintained by running
   @cabal update@.
 -}

module Distribution.Hackage.DB.Path where

import Distribution.Hackage.DB.Errors

import Control.Exception
import System.Directory
import System.FilePath

cabalStateDir :: IO FilePath
cabalStateDir :: IO FilePath
cabalStateDir = FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"cabal"

cabalTarballDir :: String -> IO FilePath
cabalTarballDir :: FilePath -> IO FilePath
cabalTarballDir FilePath
repo = do
  FilePath
csd <- IO FilePath
cabalStateDir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
joinPath [FilePath
csd, FilePath
"packages", FilePath
repo]

hackageTarballDir :: IO FilePath
hackageTarballDir :: IO FilePath
hackageTarballDir = FilePath -> IO FilePath
cabalTarballDir FilePath
"hackage.haskell.org"

-- | Determine the default path of the Hackage database, which typically
-- resides at @"$HOME\/.cabal\/packages\/hackage.haskell.org\/00-index.tar"@.
-- Running the command @"cabal update"@ will keep that file up-to-date.

hackageTarball :: IO FilePath
hackageTarball :: IO FilePath
hackageTarball = do
  FilePath
htd <- IO FilePath
hackageTarballDir
  let idx00 :: FilePath
idx00 = FilePath
htd FilePath -> FilePath -> FilePath
</> FilePath
"00-index.tar"
      idx01 :: FilePath
idx01 = FilePath
htd FilePath -> FilePath -> FilePath
</> FilePath
"01-index.tar"
  -- Using 'msum' here would be nice, but unfortunetaly there was no reliable
  -- MonadPlus instance for IO in pre 8.x versions of GHC. So we use the ugly
  -- code for sake of portability.
  Bool
have01 <- FilePath -> IO Bool
doesFileExist FilePath
idx01
  if Bool
have01 then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
idx01 else do
    Bool
have00 <- FilePath -> IO Bool
doesFileExist FilePath
idx00
    if Bool
have00 then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
idx00 else
      NoHackageTarballFound -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO NoHackageTarballFound
NoHackageTarballFound