DistroCache.hs

-- |A DistroCache is a distribution (a list of DebSource) with a name
-- and a directory which it can use to download and store files.  It
-- is the basis for several of the other Debian modules.
--
-- Author: David Fox <david.fox@linspire.com>
module Linspire.Debian.DistroCache
    (DistroCache,
     -- * Constructors
     distroFromConfig,		-- FilePath -> String -> IO DistroCache
     distroFromConfig',		-- FilePath -> String -> DistroCache
     makeDistro,		-- FilePath -> String -> [DebSource] -> DistroCache
     -- * Accessors
     dist,			-- DistroCache -> String
     aptDir,			-- DistroCache -> String -> FilePath
     aptRootDir,		-- DistroCache -> FilePath
     sources,			-- DistroCache -> [DebSource],
     sourcesPath,		-- DistroCache -> FilePath
     poolRoot,			-- DistroCache -> FilePath
     localPool,			-- DistroCache -> FilePath -> [DebSource]
     cleanRoot,			-- DistroCache -> String -> FilePath
     dirtyRoot)			-- DistroCache -> String -> FilePath
    where

import Control.Monad
import Data.List
import Data.Maybe
import System.Directory
import System.IO
import Text.Regex
import Linspire.Unix.FilePath
import Linspire.Debian.SourcesList

-- FIXME: we should have a flag to indicate whether we have
-- verified the files that distroFromConfig creates.
data DistroCache =
    Distro {top :: FilePath,			-- ^ The autobuilder cache directory
            dist :: String,			-- ^ Name of the distro.
	    sources :: [DebSource]} 		-- ^ The contents of the sources.list file.

instance Eq DistroCache where
    Distro a b _ == Distro c d _ = a == c && b == d

distDir :: DistroCache -> FilePath
distDir (Distro top dist _) = top ++ "/dists/" ++ dist

-- |The directory where package's source deb is downloaded to.
aptDir :: DistroCache -> String -> FilePath
aptDir distro package = distDir distro ++ "/apt/" ++ package

-- |The partial environment for performing apt-gets
aptRootDir :: DistroCache -> FilePath
aptRootDir distro = distDir distro ++ "/aptEnv"

sourcesPath :: DistroCache -> FilePath
sourcesPath distro = distDir distro ++ "/sources"

localPool :: DistroCache -> FilePath -> [DebSource]
localPool distro dir = 
    parseSourcesList ("\ndeb file://" ++ dir ++ " " ++ dist distro ++ " main" ++
                      "\ndeb-src file://" ++ dir ++ " " ++ dist distro ++ " main\n")

poolRoot :: DistroCache -> FilePath
poolRoot distro = distDir distro ++ "/upload-env"

dirtyRoot :: DistroCache -> String -> FilePath
dirtyRoot distro strictness = distDir distro ++ "/build-" ++ strictness

cleanRoot :: DistroCache -> String -> FilePath
cleanRoot distro strictness = distDir distro ++ "/clean-" ++ strictness

-- |Given the text for a source list in the config file, return
-- a Distro object.  This is an IO operation because we may
-- need to create the sources.list files.
distroFromConfig :: FilePath -> String -> IO DistroCache
distroFromConfig top text =
    do
      let distro@(Distro _ dist _) = distroFromConfig' top text
      let dir = distDir distro
      distExists <- doesFileExist (sourcesPath distro)
      case distExists of
        True ->
            do
	      fileSources <- readFile (sourcesPath distro) >>= return . parseSourcesList
	      case fileSources == (sources distro) of
	        True -> return distro
	        False ->
                    do
                      ePut ("Sources for '" ++ dist ++ "' don't match sources from the configuration file" ++
			    ":\n\n" ++ sourcesPath distro ++ ":\n\n" ++
                            consperse "\n" (map show fileSources) ++
			    "\n\nConfiguration file:\n\n" ++
                            consperse "\n" (map show (sources distro)) ++ "\n\n" ++
			    "This means it is possible that everything in\n" ++
                            dir ++ " is invalid.")
                      -- removeRecursiveSafely dir
                      error ("Please remove " ++ dir ++ " and restart.")
        False ->
	    do
              createDirectoryIfMissing True dir
	      writeFile (sourcesPath distro) (consperse "\n" (map show (sources distro)) ++ "\n")
	      return distro

-- |Create Distro info from an entry in the config file, which
-- includes a dist name and the lines of the sources.list file.
-- This also creates the basic 
distroFromConfig' :: FilePath -> String -> DistroCache
distroFromConfig' top text =
    -- FIXME: This regexp is too permissive - it will match almost anything
    let re = mkRegex "^[ \t\n]*([^ \t\n]+)[ \t\n]+(.*)$" in
    case matchRegex re text of
      Just [dist, sources] -> Distro top dist (parseSourcesList sources)
      _ -> error "Syntax error in sources text"

-- |This is unsafe in the sense that we don't know that the
-- directories have been created and the sources.list files
-- have been written.
makeDistro :: FilePath -> String -> [DebSource] -> DistroCache
makeDistro top dist sources = Distro top dist sources

ePut :: String -> IO ()
ePut s = hPutStrLn stderr s

-- |The mighty consperse function
consperse :: [a] -> [[a]] -> [a]
consperse sep items = concat (intersperse sep items)