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