{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
module Debian.Debianize.Bundled
( builtIn
, aptCacheShowPkg
, aptCacheProvides
, aptCacheDepends
, aptCacheConflicts
, aptVersions
, hcVersion
, parseVersion'
, tests
) where
import Control.Exception (SomeException, try)
import Control.Monad ((<=<))
import Data.Char (isAlphaNum, toLower)
import Data.List (groupBy, intercalate, isPrefixOf, stripPrefix)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Set as Set (difference, fromList)
import Debian.GHC ()
import Debian.Relation (BinPkgName(..))
import Debian.Relation.ByteString ()
import Debian.Version (DebianVersion, parseDebianVersion', prettyDebianVersion)
import Distribution.Package (mkPackageName, PackageIdentifier(..), unPackageName)
import Data.Version (parseVersion)
import Distribution.Version(mkVersion, mkVersion', Version)
import Distribution.Simple.Compiler (CompilerFlavor(GHCJS))
import System.Process (readProcess, showCommandForUser)
import Test.HUnit (assertEqual, Test(TestList, TestCase))
import Text.ParserCombinators.ReadP (char, endBy1, munch1, ReadP, readP_to_S)
import Text.Regex.TDFA ((=~))
import UnliftIO.Memoize (memoizeMVar, Memoized, runMemoized)
builtIn :: CompilerFlavor -> IO [PackageIdentifier]
builtIn :: CompilerFlavor -> IO [PackageIdentifier]
builtIn CompilerFlavor
hc = do
Just String
hep <- CompilerFlavor -> IO (Memoized (Maybe String))
hcExecutablePath CompilerFlavor
hc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized
Just BinPkgName
hcname <- String -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName String
hep forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized
forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BinPkgName -> IO (Memoized [PackageIdentifier])
aptCacheProvides BinPkgName
hcname
hcExecutable :: CompilerFlavor -> String
hcExecutable :: CompilerFlavor -> String
hcExecutable = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
hcExecutablePath :: CompilerFlavor -> IO (Memoized (Maybe FilePath))
hcExecutablePath :: CompilerFlavor -> IO (Memoized (Maybe String))
hcExecutablePath CompilerFlavor
hc = forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"which" [CompilerFlavor -> String
hcExecutable CompilerFlavor
hc] String
"")
hcVersion :: CompilerFlavor -> IO (Maybe Version)
hcVersion :: CompilerFlavor -> IO (Maybe Version)
hcVersion CompilerFlavor
hc = do
Just String
hcpath <- forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CompilerFlavor -> IO (Memoized (Maybe String))
hcExecutablePath CompilerFlavor
hc
String
ver <- String -> [String] -> String -> IO String
readProcess String
hcpath
[case CompilerFlavor
hc of
CompilerFlavor
GHCJS -> String
"--numeric-ghc-version"
CompilerFlavor
_ -> String
"--numeric-version"]
String
""
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing String -> Maybe Version
parseVersion' (forall a. [a] -> Maybe a
listToMaybe (String -> [String]
lines String
ver))
hcBinPkgName :: FilePath -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName :: String -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName String
path = forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar forall a b. (a -> b) -> a -> b
$ do
String
s <- String -> [String] -> String -> IO String
readProcess String
"dpkg" [String
"-S", String
path] String
""
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
':')) (String -> [String]
lines String
s) of
[] -> forall a. Maybe a
Nothing
[String
name] -> forall a. a -> Maybe a
Just (String -> BinPkgName
BinPkgName String
name)
[String]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unexpected output from " forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
"dpkg" [String
"-S", String
path] forall a. [a] -> [a] -> [a]
++ String
": ++ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s
aptCacheProvides :: BinPkgName -> IO (Memoized [PackageIdentifier])
aptCacheProvides :: BinPkgName -> IO (Memoized [PackageIdentifier])
aptCacheProvides = forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> IO [PackageIdentifier]
packageIdentifiers
packageIdentifiers :: BinPkgName -> IO [PackageIdentifier]
packageIdentifiers :: BinPkgName -> IO [PackageIdentifier]
packageIdentifiers BinPkgName
hcname =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageIdentifier
parsePackageIdentifier' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe String
dropRequiredSuffix String
".conf" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"package.conf.d") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Char
a Char
b -> (Char
a forall a. Eq a => a -> a -> Bool
== Char
'/') forall a. Eq a => a -> a -> Bool
== (Char
b forall a. Eq a => a -> a -> Bool
== Char
'/'))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinPkgName -> IO [String]
binPkgFiles BinPkgName
hcname
dropRequiredSuffix :: String -> String -> Maybe String
dropRequiredSuffix :: String -> String -> Maybe String
dropRequiredSuffix String
suff String
x =
let (String
x', String
suff') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
suff) String
x in if String
suff forall a. Eq a => a -> a -> Bool
== String
suff' then forall a. a -> Maybe a
Just String
x' else forall a. Maybe a
Nothing
binPkgFiles :: BinPkgName -> IO [FilePath]
binPkgFiles :: BinPkgName -> IO [String]
binPkgFiles BinPkgName
hcname = String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"dpkg" [String
"-L", BinPkgName -> String
unBinPkgName BinPkgName
hcname] String
""
aptCacheConflicts :: String -> DebianVersion -> IO [BinPkgName]
aptCacheConflicts :: String -> DebianVersion -> IO [BinPkgName]
aptCacheConflicts String
hcname DebianVersion
ver =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {source1}.
RegexContext Regex source1 (String, String, String, [String]) =>
source1 -> Maybe BinPkgName
doLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> IO (Memoized (Either SomeException String))
aptCacheDepends String
hcname (forall a. Show a => a -> String
show (DebianVersion -> Doc
prettyDebianVersion DebianVersion
ver)))
where
doLine :: source1 -> Maybe BinPkgName
doLine source1
s = case source1
s forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[ ]*Conflicts:[ ]*<(.*)>$" :: (String, String, String, [String]) of
(String
_, String
_, String
_, [String
name]) -> forall a. a -> Maybe a
Just (String -> BinPkgName
BinPkgName String
name)
(String, String, String, [String])
_ -> forall a. Maybe a
Nothing
aptCacheDepends :: String -> String -> IO (Memoized (Either SomeException String))
aptCacheDepends :: String -> String -> IO (Memoized (Either SomeException String))
aptCacheDepends String
hcname String
ver =
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> [String] -> String -> IO String
readProcess String
"apt-cache" [String
"depends", String
hcname forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
ver] String
""))
aptVersions :: BinPkgName -> IO [DebianVersion]
aptVersions :: BinPkgName -> IO [DebianVersion]
aptVersions =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a b. (a -> b) -> [a] -> [b]
map forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"Reverse Depends:") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"Versions:") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BinPkgName -> IO (Memoized (Either SomeException String))
aptCacheShowPkg)
aptCacheShowPkg :: BinPkgName -> IO (Memoized (Either SomeException String))
aptCacheShowPkg :: BinPkgName -> IO (Memoized (Either SomeException String))
aptCacheShowPkg BinPkgName
hcname =
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> [String] -> String -> IO String
readProcess String
"apt-cache" [String
"showpkg", BinPkgName -> String
unBinPkgName BinPkgName
hcname] String
""))
parsePackageIdentifier :: ReadP PackageIdentifier
parsePackageIdentifier :: ReadP PackageIdentifier
parsePackageIdentifier =
([String], Version) -> PackageIdentifier
makeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. ReadP a -> ReadP sep -> ReadP [a]
endBy1 ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isAlphaNum) (Char -> ReadP Char
char Char
'-') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Version
parseCabalVersion)
where
makeId :: ([String], Version) -> PackageIdentifier
makeId :: ([String], Version) -> PackageIdentifier
makeId ([String]
xs, Version
v) = PackageIdentifier {pkgName :: PackageName
pkgName = String -> PackageName
mkPackageName (forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
xs), pkgVersion :: Version
pkgVersion = Version
v}
parseMaybe :: ReadP a -> String -> Maybe a
parseMaybe :: forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP a
p = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadP a -> ReadS a
readP_to_S ReadP a
p
parseVersion' :: String -> Maybe Version
parseVersion' :: String -> Maybe Version
parseVersion' = forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP Version
parseCabalVersion
parseCabalVersion :: ReadP Version
parseCabalVersion :: ReadP Version
parseCabalVersion = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Version
mkVersion' ReadP Version
parseVersion
parsePackageIdentifier' :: String -> Maybe PackageIdentifier
parsePackageIdentifier' :: String -> Maybe PackageIdentifier
parsePackageIdentifier' = forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier
tests :: Test
tests :: Test
tests = [Test] -> Test
TestList [ Assertion -> Test
TestCase (forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Bundled1"
(forall a. a -> Maybe a
Just (PackageName -> Version -> PackageIdentifier
PackageIdentifier (String -> PackageName
mkPackageName String
"HUnit") ([Int] -> Version
mkVersion [Int
1,Int
2,Int
3])))
(forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier String
"HUnit-1.2.3"))
, Assertion -> Test
TestCase (forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Bundled2"
forall a. Maybe a
Nothing
(forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier String
"HUnit-1.2.3 "))
, Assertion -> Test
TestCase forall a b. (a -> b) -> a -> b
$ do
String
ghc <- forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"which" [String
"ghc"] String
""
let ver :: Maybe String
ver = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/')) (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"/opt/ghc/" String
ghc)
[PackageIdentifier]
acp <- forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BinPkgName -> IO (Memoized [PackageIdentifier])
aptCacheProvides (String -> BinPkgName
BinPkgName (String
"ghc" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"-" forall a. [a] -> [a] -> [a]
++) Maybe String
ver))
let expected :: Set String
expected = forall a. Ord a => [a] -> Set a
Set.fromList
[String
"array", String
"base", String
"binary", String
"bin-package-db", String
"bytestring", String
"Cabal",
String
"containers", String
"deepseq", String
"directory", String
"filepath", String
"ghc", String
"ghc-prim",
String
"haskeline", String
"hoopl", String
"hpc", String
"integer-gmp", String
"pretty", String
"process",
String
"template-haskell", String
"terminfo", String
"time", String
"transformers", String
"unix", String
"xhtml"]
actual :: Set String
actual = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map (PackageName -> String
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName) [PackageIdentifier]
acp)
missing :: Maybe String -> Set String
missing (Just String
"8.0.1") = forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db"]
missing (Just String
"8.0.2") = forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db"]
missing Maybe String
_ = forall a. Monoid a => a
mempty
extra :: Maybe String -> Set String
extra (Just String
"7.8.4") = forall a. Ord a => [a] -> Set a
Set.fromList [String
"haskell2010",String
"haskell98",String
"old-locale",String
"old-time"]
extra (Just String
"8.0.1") = forall a. Ord a => [a] -> Set a
Set.fromList [String
"ghc-boot",String
"ghc-boot-th",String
"ghci"]
extra (Just String
"8.0.2") = forall a. Ord a => [a] -> Set a
Set.fromList [String
"ghc-boot",String
"ghc-boot-th",String
"ghci"]
extra Maybe String
_ = forall a. Monoid a => a
mempty
forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Bundled4"
(Maybe String -> Set String
missing Maybe String
ver, Maybe String -> Set String
extra Maybe String
ver)
(forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set String
expected Set String
actual, forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set String
actual Set String
expected)
]