-- | Determine whether a specific version of a Haskell package is
-- bundled with into this particular version of the given compiler.

{-# LANGUAGE CPP, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}
module Debian.Debianize.Bundled
    ( builtIn
    ) where

import Control.Applicative ((<$>))
import Control.DeepSeq (force)
import Control.Exception (try, SomeException)
import Data.Char (toLower)
import Data.Function (on)
import Data.Function.Memoize (memoize2)
import Data.List (sortBy, isPrefixOf)
import Data.Map as Map (Map)
import Data.Maybe (mapMaybe, listToMaybe)
import Data.Version (Version(..), parseVersion)
import Debian.Debianize.VersionSplits (DebBase(DebBase), VersionSplits, cabalFromDebian')
import Debian.GHC ({- Memoizable instances -})
import Debian.Relation (BinPkgName(..))
import Debian.Relation.ByteString()
import Debian.Version (DebianVersion, parseDebianVersion)
import Distribution.Simple.Compiler (CompilerFlavor(..), {-PackageDB(GlobalPackageDB), compilerFlavor-})
import Distribution.Package (PackageIdentifier(..), PackageName(..) {-, Dependency(..)-})
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess)
import System.Unix.Chroot (useEnv)
import Text.Regex.TDFA ((=~))
import Text.ParserCombinators.ReadP (readP_to_S)

-- | Find out what version, if any, of a cabal library is built into
-- the newest version of haskell compiler hc in environment root.  For
-- GHC this is done by looking at what virtual packages debian package
-- provides.  I have modified the ghcjs packaging to generate the
-- required virtual packages in the Provides line.  For other
-- compilers it maybe be unimplemented.
builtIn :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> PackageName -> Maybe Version
builtIn splits hc root lib = do
  f $ memoize2 (\ hc' root' -> unsafePerformIO (builtIn' splits hc' root')) hc root
    where
      f :: (DebianVersion, [PackageIdentifier]) -> Maybe Version
      f (hcv, ids) = case map pkgVersion (filter (\ i -> pkgName i == lib) ids) of
                [] -> Nothing
                [v] -> Just v
                vs -> error $ show hc ++ "-" ++ show hcv ++ " in " ++ show root ++ " provides multiple versions of " ++ show lib ++ ": " ++ show vs

-- | Ok, lets see if we can infer the built in packages from the
-- Provides field returned by apt-cache.
builtIn' :: Map PackageName VersionSplits -> CompilerFlavor -> FilePath -> IO (DebianVersion, [PackageIdentifier])
builtIn' splits hc root = do
  lns <- lines . either (\ (e :: SomeException) -> error $ "builtIn: " ++ show e) id <$> try (chroot root (readProcess "apt-cache" ["showpkg", hcname] ""))
  let hcs = map words $ takeBetween (isPrefixOf "Provides:") (isPrefixOf "Reverse Provides:") lns
      hcs' = reverse . sortBy (compare `on` fst) . map doHCVersion $ hcs
  case hcs' of
    [] -> error $ "No versions of " ++ show hc ++ " (" ++ show hcname ++ ") in " ++ show root
    ((v, pids) : _) -> return (v, pids)
    where
      BinPkgName hcname = BinPkgName (map toLower (show hc))
      -- Find out what library versions are provided by the latest version
      -- of the compiler.
      doHCVersion :: [String] -> (DebianVersion, [PackageIdentifier])
      doHCVersion (versionString : "-" : deps) = (parseDebianVersion versionString, mapMaybe parsePackageID deps)
      doHCVersion x = error $ "Unexpected output from apt-cache: " ++ show x
      -- The virtual package id, which appears in the Provides
      -- line for the compiler package, is generated by the
      -- function package_id_to_virtual_package in Dh_Haskell.sh.
      -- It consists of the library's debian package name and the
      -- first five characters of the checksum.
      -- parsePID "libghc-unix-dev-2.7.0.1-2a456" -> Just (PackageIdentifier "unix" (Version [2,7,0,1] []))
      parsePackageID :: String -> Maybe PackageIdentifier
      parsePackageID s = case s =~ ("lib" ++ hcname ++ "-(.*)-dev-([0-9.]*)-.....$") :: (String, String, String, [String]) of
                     (_, _, _, [base, vs]) -> case listToMaybe (map fst $ filter ((== "") . snd) $ readP_to_S parseVersion $ vs) of
                                                Just v -> Just (cabalFromDebian' splits (DebBase base) v)
                                                Nothing -> Nothing
                     _ -> Nothing
      chroot "/" = id
      chroot _ = useEnv root (return . force)

takeBetween :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]
takeBetween startPred endPred = takeWhile (not . endPred) . dropWhile startPred . dropWhile (not . startPred)