SourcePackagesOfCachedIndex.hs

{-# LANGUAGE PackageImports, ScopedTypeVariables, TupleSections #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
module Debian.Repo.Package.SourcePackagesOfCachedIndex
    ( sourcePackagesOfCachedIndex
    ) where

import Control.Exception as E (catch)
import "mtl" Control.Monad.Trans (MonadIO(..))
import Data.List as List (map)
import Debian.Repo.Monads.Apt (insertSourcePackages, lookupSourcePackages, MonadApt(..), readParagraphs)
import Debian.Repo.Package.Internal.IndexCacheFile (indexCacheFile)
import Debian.Repo.Package.ToSourcePackage (toSourcePackage)
import Debian.Repo.Types.AptCache (AptCache(rootDir))
import Debian.Repo.Types.EnvPath (EnvRoot(rootPath))
import Debian.Repo.Types.PackageIndex (PackageIndex, SourcePackage)
import Debian.Repo.Types.Release (Release)
import Debian.Repo.Types.Repo (RepoKey)
import System.FilePath (takeDirectory)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Posix (getFileStatus)

-- FIXME: assuming the index is part of the cache
sourcePackagesOfCachedIndex :: (AptCache a, MonadApt m) => a -> RepoKey -> Release -> PackageIndex -> m [SourcePackage]
sourcePackagesOfCachedIndex cache repo release index =
    do state <- getApt
       let cached = lookupSourcePackages path state
       status <- liftIO $ getFileStatus path `E.catch` (\ (_ :: IOError) -> error $ "Sources.list seems out of sync.  If a new release has been created you probably need to remove " ++ takeDirectory (rootPath (rootDir cache)) ++ " and try again - sorry about that.")
       case cached of
         Just (status', packages) | status == status' -> return packages
         _ -> do paragraphs <- liftIO $ unsafeInterleaveIO (readParagraphs path)
                 let packages = List.map (toSourcePackage index) paragraphs
                 putApt (insertSourcePackages path (status, packages) state)
                 return packages
    where
      path = rootPath (rootDir cache) ++ indexCacheFile cache repo release index