module Distribution.Package.Debian.Bundled
(
Bundled
, bundledWith
, isBundled
, isLibrary
, docPrefix
, builtIns
) where
import qualified Data.ByteString.Char8 as B
import Data.Function (on)
import Data.List (find,isPrefixOf,sortBy)
import Data.Maybe (maybeToList)
import Data.Version (Version(..))
import Debian.Control(Control'(Control), fieldValue, parseControlFromFile)
import Debian.Relation.ByteString()
import Debian.Relation(Relation(Rel),parseRelations)
import Distribution.InstalledPackageInfo(InstalledPackageInfo, libraryDirs, sourcePackageId)
import Distribution.Simple.Compiler (Compiler(..), CompilerId(..), CompilerFlavor(..), PackageDB(GlobalPackageDB), compilerFlavor)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Simple.PackageIndex (PackageIndex, SearchResult(None, Unambiguous, Ambiguous), allPackages, searchByName)
import Distribution.Simple.Program (configureAllKnownPrograms, defaultProgramConfiguration)
import Distribution.Package (PackageIdentifier(..), PackageName(..), Dependency(..))
import Distribution.Verbosity(normal)
import Distribution.Version (withinRange)
import Text.ParserCombinators.Parsec(ParseError)
import Text.Regex.TDFA ((=~))
bundledWith :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Maybe [PackageIdentifier]
bundledWith builtIns c =
let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) $ compilerId c)
in thd `fmap` find (\(n,v,_) -> (n,v) == cv) builtIns
where thd (_,_,x) = x
isBundled :: [(CompilerFlavor, Version, [PackageIdentifier])] -> Compiler -> Dependency -> Bool
isBundled builtIns c (Dependency pkg version) =
let cv = (compilerFlavor c, (\ (CompilerId _ v) -> v) (compilerId c))
in
case find (\(n, k, _) -> (n,k) == cv) builtIns of
Nothing -> False
(Just (_, _, cb)) ->
any checkVersion $ pkgVersion `fmap` filter ((== pkg) . pkgName) cb
where checkVersion = flip withinRange version
type Bundled = (CompilerFlavor, Version, [PackageIdentifier])
builtIns :: Compiler -> IO [Bundled]
builtIns compiler =
do ghc6 <- fmap maybeToList $ ghc6BuiltIns compiler
return $ ghc6 ++ [ (GHC, Version [6,8,3] [], ghc683BuiltIns)
, (GHC, Version [6,8,2] [], ghc682BuiltIns)
, (GHC, Version [6,8,1] [], ghc681BuiltIns)
, (GHC, Version [6,6,1] [], ghc661BuiltIns)
, (GHC, Version [6,6] [], ghc66BuiltIns)
]
ghc6BuiltIns :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))
ghc6BuiltIns compiler@(Compiler (CompilerId GHC compilerVersion) _) =
#ifdef CABAL19
do installedPackages <- getInstalledPackageIndex compiler
ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list"
let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)
return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))
#else
do mInstalledPackages <- getInstalledPackageIndex compiler
case mInstalledPackages of
Nothing -> error "Could not find the installed package database."
(Just installedPackages) ->
do ghc6Files <- fmap lines $ readFile "/var/lib/dpkg/info/ghc6.list"
let ghcProvides = filter (\package -> any (\dir -> elem dir ghc6Files) (libraryDirs package)) (allPackages installedPackages)
return (Just (GHC, compilerVersion, map sourcePackageId ghcProvides))
#endif
ghc6BuiltIns _ = return Nothing
ghc6BuiltIns' :: Compiler -> IO (Maybe (CompilerFlavor, Version, [PackageIdentifier]))
ghc6BuiltIns' compiler@(Compiler (CompilerId GHC compilerVersion) _) =
do eDebs <- ghc6Provides
case eDebs of
Left e -> error e
Right debNames ->
#ifdef CABAL19
do installedPackages <- getInstalledPackageIndex compiler
let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ extractBaseName n) installedPackages) debNames
return $ Just (GHC, compilerVersion, packages)
#else
do mInstalledPackages <- getInstalledPackageIndex compiler
case mInstalledPackages of
Nothing -> error "Could not find the installed package database."
(Just installedPackages) ->
let packages = concatMap (\n -> fromRight $ installedVersions (fromRight $ extractBaseName n) installedPackages) debNames
in
return $ Just (GHC, compilerVersion, packages)
#endif
where
fromRight (Right r) = r
fromRight (Left e) = error e
ghc6BuiltIns' compiler@(Compiler _ _) = return Nothing
ghc6Provides :: IO (Either String [String])
ghc6Provides =
do eC <- parseControlFromFile "/var/lib/dpkg/status" :: IO (Either ParseError (Control' B.ByteString))
case eC of
Left e -> return $ Left (show e)
Right (Control c) ->
case find (\p -> fieldValue "Package" p == Just (B.pack "ghc6")) c of
Nothing -> return $ Left "You do not seem to have ghc6 installed."
(Just p) ->
case fieldValue "Provides" p of
Nothing -> return $ Left "Your ghc6 package does not seem to Provide anything."
(Just p) ->
case parseRelations p of
(Left e) -> return (Left (show e))
(Right relations) ->
return $ Right $ filter (isPrefixOf "libghc6-") $ map (\ (Rel pkgName _ _) -> pkgName) (concat relations)
extractBaseName :: String -> Either String String
extractBaseName name =
let (_,_,_,subs) = (name =~ "^libghc6-(.*)-.*$") :: (String, String, String, [String])
in case subs of
[base] -> Right base
_ -> Left ("When attempt to extract the base name of " ++ name ++ " I found the following matches: " ++ show subs)
getInstalledPackageIndex compiler =
do pc <- configureAllKnownPrograms normal defaultProgramConfiguration
getInstalledPackages normal compiler [GlobalPackageDB] pc
installedVersions :: String -> PackageIndex -> Either String [PackageIdentifier]
installedVersions name packageIndex =
case searchByName packageIndex name of
None -> Left $ "The package " ++ name ++ " does not seem to be installed."
Unambiguous pkgs ->
case sortBy (compare `on` (pkgVersion . sourcePackageId)) pkgs of
[] -> Left $ "Odd. searchByName returned an empty Unambiguous match for " ++ name
ps -> Right (map sourcePackageId ps)
v :: String -> [Int] -> PackageIdentifier
v n x = PackageIdentifier (PackageName n) (Version x [])
ghc683BuiltIns :: [PackageIdentifier]
ghc683BuiltIns = ghc682BuiltIns
ghc682BuiltIns :: [PackageIdentifier]
ghc682BuiltIns = [
v "Cabal" [1,2,3,0],
v "array" [0,1,0,0],
v "base" [3,0,1,0],
v "bytestring" [0,9,0,1],
v "containers" [0,1,0,1],
v "directory" [1,0,0,0],
v "filepath" [1,1,0,0],
v "ghc" [6,8,2,0],
v "haskell98" [1,0,1,0],
v "hpc" [0,5,0,0],
v "old-locale" [1,0,0,0],
v "old-time" [1,0,0,0],
v "packedstring" [0,1,0,0],
v "pretty" [1,0,0,0],
v "process" [1,0,0,0],
v "random" [1,0,0,0],
v "readline" [1,0,1,0],
v "template-haskell" [2,2,0,0],
v "unix" [2,3,0,0]
]
ghc681BuiltIns :: [PackageIdentifier]
ghc681BuiltIns = [
v "base" [3,0,0,0],
v "Cabal" [1,2,2,0],
v "GLUT" [2,1,1,1],
v "HGL" [3,2,0,0],
v "HUnit" [1,2,0,0],
v "OpenAL" [1,3,1,1],
v "OpenGL" [2,2,1,1],
v "QuickCheck" [1,1,0,0],
v "X11" [1,2,3,1],
v "array" [0,1,0,0],
v "bytestring" [0,9,0,1],
v "cgi" [3001,1,5,1],
v "containers" [0,1,0,0],
v "directory" [1,0,0,0],
v "fgl" [5,4,1,1],
v "filepatch" [1,1,0,0],
v "ghc" [6,8,1,0],
v "haskell-src" [1,0,1,1],
v "haskell98" [1,0,1,0],
v "hpc" [0,5,0,0],
v "html" [1,0,1,1],
v "mtl" [1,1,0,0],
v "network" [2,1,0,0],
v "old-locale" [1,0,0,0],
v "old-time" [1,0,0,0],
v "packedstring" [0,1,0,0],
v "parallel" [1,0,0,0],
v "parsec" [2,1,0,0],
v "pretty" [1,0,0,0],
v "process" [1,0,0,0],
v "random" [1,0,0,0],
v "readline" [1,0,1,0],
v "regex-base" [0,72,0,1],
v "regex-compat" [0,71,0,1],
v "regex-posix" [0,72,0,1],
v "stm" [2,1,1,0],
v "template-haskell" [2,2,0,0],
v "time" [1,1,2,0],
v "unix" [2,2,0,0],
v "xhtml" [3000,0,2,1]
]
ghc661BuiltIns :: [PackageIdentifier]
ghc661BuiltIns = [
v "base" [2,1,1],
v "Cabal" [1,1,6,2],
v "cgi" [3001,1,1],
v "fgl" [5,4,1],
v "filepath" [1,0],
v "ghc" [6,6,1],
v "GLUT" [2,1,1],
v "haskell98" [1,0],
v "haskell-src" [1,0,1],
v "HGL" [3,1,1],
v "html" [1,0,1],
v "HUnit" [1,1,1],
v "mtl" [1,0,1],
v "network" [2,0,1],
v "OpenAL" [1,3,1],
v "OpenGL" [2,2,1],
v "parsec" [2,0],
v "QuickCheck" [1,0,1],
v "readline" [1,0],
v "regex-base" [0,72],
v "regex-compat" [0,71],
v "regex-posix" [0,71],
v "rts" [1,0],
v "stm" [2,0],
v "template-haskell" [2,1],
v "time" [1,1,1],
v "unix" [2,1],
v "X11" [1,2,1],
v "xhtml" [3000,0,2]
]
ghc66BuiltIns :: [PackageIdentifier]
ghc66BuiltIns = [
v "base" [2,0],
v "Cabal" [1,1,6],
v "cgi" [2006,9,6],
v "fgl" [5,2],
v "ghc" [6,6],
v "GLUT" [2,0],
v "haskell98" [1,0],
v "haskell-src" [1,0],
v "HGL" [3,1],
v "html" [1,0],
v "HTTP" [2006,7,7],
v "HUnit" [1,1],
v "mtl" [1,0],
v "network" [2,0],
v "OpenAL" [1,3],
v "OpenGL" [2,1],
v "parsec" [2,0],
v "QuickCheck" [1,0],
v "readline" [1,0],
v "regex-base" [0,71],
v "regex-compat" [0,71],
v "regex-posix" [0,71],
v "rts" [1,0],
v "stm" [2,0],
v "template-haskell" [2,0],
v "time" [1,0],
v "unix" [1,0],
v "X11" [1,1],
v "xhtml" [2006,9,13]
]
isLibrary :: Compiler -> Dependency -> Bool
isLibrary _ (Dependency (PackageName "happy") _ ) = False
isLibrary _ _ = True
docPrefix :: String -> String
docPrefix _ = "haskell-"