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 ()
import Debian.Relation (BinPkgName(..))
import Debian.Relation.ByteString()
import Debian.Version (DebianVersion, parseDebianVersion)
import Distribution.Simple.Compiler (CompilerFlavor(..), )
import Distribution.Package (PackageIdentifier(..), PackageName(..) )
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)
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
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))
doHCVersion :: [String] -> (DebianVersion, [PackageIdentifier])
doHCVersion (versionString : "-" : deps) = (parseDebianVersion versionString, mapMaybe parsePackageID deps)
doHCVersion x = error $ "Unexpected output from apt-cache: " ++ show x
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)