module Debian.Debianize.Bundled
( builtIn
, aptCacheShowPkg
, aptCacheProvides
, aptCacheDepends
, aptCacheConflicts
, aptVersions
, hcVersion
) where
import Control.Applicative ((<$>))
import Control.DeepSeq (force, NFData)
import Control.Exception (SomeException, try)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Trans (MonadIO)
import Data.Char (toLower)
import Data.Function.Memoize (memoize2, memoize3)
import Data.List (groupBy, isPrefixOf, isSuffixOf)
import Data.Maybe (catMaybes, listToMaybe, mapMaybe)
import Data.Version (parseVersion, Version)
import Debian.GHC ()
import Debian.Relation (BinPkgName(..))
import Debian.Relation.ByteString ()
import Debian.Version (DebianVersion, parseDebianVersion', prettyDebianVersion)
import Debug.Trace (trace)
import Distribution.Package (PackageIdentifier(..), PackageName(..))
import Distribution.Simple.Compiler (CompilerFlavor(..))
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess, showCommandForUser)
import System.Unix.Chroot (useEnv)
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Regex.TDFA ((=~))
builtIn :: CompilerFlavor -> FilePath -> [PackageIdentifier]
builtIn hc root =
let Just hcname = (hcExecutablePath root hc >>= hcBinPkgName root) in
aptCacheProvides hcname root
parseVersion' :: String -> Maybe Version
parseVersion' = listToMaybe . map fst . filter ((== "") . snd) . readP_to_S parseVersion
hcExecutable :: CompilerFlavor -> String
hcExecutable = map toLower . show
hcExecutablePath :: FilePath -> CompilerFlavor -> Maybe FilePath
hcExecutablePath = memoize2 $ \root hc ->
listToMaybe $ lines $ unsafePerformIO $ chroot root (readProcess "which" [hcExecutable hc] "")
hcVersion :: FilePath -> CompilerFlavor -> Maybe Version
hcVersion root hc =
let Just hcpath = hcExecutablePath root hc in
maybe Nothing parseVersion' $
listToMaybe $
lines $
unsafePerformIO . chroot root $
readProcess hcpath
[case hc of
#if MIN_VERSION_Cabal(1,22,0)
GHCJS -> "--numeric-ghc-version"
#endif
_ -> "--numeric-version"]
""
hcBinPkgName :: FilePath -> FilePath -> Maybe BinPkgName
hcBinPkgName = memoize2 $ \root path ->
let s = unsafePerformIO (chroot root (readProcess "dpkg" ["-S", path] "")) in
case map (takeWhile (/= ':')) (lines s) of
[] -> Nothing
[name] -> Just (BinPkgName name)
_ -> error $ "Unexpected output from " ++ showCommandForUser "dpkg" ["-S", path] ++ ": ++ " ++ show s
aptCacheProvides :: BinPkgName -> FilePath -> [PackageIdentifier]
aptCacheProvides = memoize2 aptCacheProvides'
where
aptCacheProvides' hcname root =
trace ("aptCacheProvides " ++ show hcname ++ " in " ++ root ++ " -> " ++ show pis) pis
where
pis = (catMaybes .
map parseLib .
filter (isSuffixOf ".conf") .
map last .
filter (elem "package.conf.d") .
map (groupBy (\a b -> (a == '/') == (b == '/')))) lns
lns = lines $ unsafePerformIO (chroot root (readProcess "dpkg" ["-L", unBinPkgName hcname] ""))
parseLib :: String -> Maybe PackageIdentifier
parseLib s =
case s =~ ("(.*)-([0-9.]*)-([a-f0-9]*).conf$") :: (String, String, String, [String]) of
(_, _, _, [cabalName, ver, _sum]) ->
case parseVersion' ver of
Just v -> Just (PackageIdentifier (PackageName cabalName) v)
_ -> Nothing
_ -> Nothing
aptCacheConflicts :: FilePath -> String -> DebianVersion -> [BinPkgName]
aptCacheConflicts root hcname ver =
either (\ _ -> []) (mapMaybe doLine . lines) (aptCacheDepends root hcname (show (prettyDebianVersion ver)))
where
doLine s = case s =~ "^[ ]*Conflicts:[ ]*<(.*)>$" :: (String, String, String, [String]) of
(_, _, _, [name]) -> Just (BinPkgName name)
_ -> Nothing
aptCacheDepends :: FilePath -> String -> String -> Either SomeException String
aptCacheDepends =
memoize3 (\ root hcname ver -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["depends", hcname ++ "=" ++ ver] ""))))
aptVersions :: FilePath -> BinPkgName -> [DebianVersion]
aptVersions root hcname =
either (\ _ -> []) (map parseDebianVersion' . filter (/= "") . map (takeWhile (/= ' ')) . takeWhile (not . isPrefixOf "Reverse Depends:") . drop 1 . dropWhile (not . isPrefixOf "Versions:") . lines) (aptCacheShowPkg root hcname)
aptCacheShowPkg :: FilePath -> BinPkgName -> Either SomeException String
aptCacheShowPkg =
memoize2 (\ root hcname -> tr root hcname $ unsafePerformIO (try (chroot root (readProcess "apt-cache" ["showpkg", unBinPkgName hcname] ""))))
where
tr root hcname x = trace ("aptCacheShowPkg " ++ show hcname ++ " in " ++ show root ++ " -> " ++ show x) x
chroot :: (NFData a, MonadIO m, MonadMask m) => String -> m a -> m a
chroot "/" = id
chroot root = useEnv root (return . force)