-- | Determine whether a specific version of a Haskell package is
-- bundled with into this particular version of the given compiler.
-- This is done by getting the "Provides" field from the output of
-- "apt-cache showpkg ghc" and
-- converting the debian package names back to Cabal package names.
-- *That* is done using the debianNameMap of CabalInfo, which is
-- built using the mapCabal, splitCabal, and remapCabal functions.

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
module Debian.Debianize.Bundled
    ( builtIn
    -- * Utilities
    , 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)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Set as Set (difference, fromList)
import Debian.GHC ({-instance Memoizable CompilerFlavor-})
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)

-- | Find out what version, if any, of a cabal library is built into
-- the newest version of haskell compiler hc in environment root.
-- This is done by looking for .conf files beneath a package.conf.d
-- directory and parsing the name.  (Probably better to actually read
-- the .conf file.)
builtIn :: CompilerFlavor -> IO [PackageIdentifier]
builtIn :: CompilerFlavor -> IO [PackageIdentifier]
builtIn CompilerFlavor
hc = do
  Just String
hep <- CompilerFlavor -> IO (Memoized (Maybe String))
hcExecutablePath CompilerFlavor
hc IO (Memoized (Maybe String))
-> (Memoized (Maybe String) -> IO (Maybe String))
-> IO (Maybe String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Memoized (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized
  Just BinPkgName
hcname <- String -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName String
hep IO (Memoized (Maybe BinPkgName))
-> (Memoized (Maybe BinPkgName) -> IO (Maybe BinPkgName))
-> IO (Maybe BinPkgName)
forall a b. IO a -> (a -> IO b) -> IO b
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

-- | Convert CompilerFlavor to an executable name in a way that works
-- for at least the cases we are interested in.  This might need to be
-- fudged or replaced as more cases become interesting.
hcExecutable :: CompilerFlavor -> String
hcExecutable :: CompilerFlavor -> String
hcExecutable = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String)
-> (CompilerFlavor -> String) -> CompilerFlavor -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerFlavor -> String
forall a. Show a => a -> String
show

-- | Use which(1) to determine full path name to haskell compiler executable
hcExecutablePath :: CompilerFlavor -> IO (Memoized (Maybe FilePath))
hcExecutablePath :: CompilerFlavor -> IO (Memoized (Maybe String))
hcExecutablePath CompilerFlavor
hc = IO (Maybe String) -> IO (Memoized (Maybe String))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String)
-> (String -> [String]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Maybe String) -> IO String -> IO (Maybe String)
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 <- Memoized (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized (Memoized (Maybe String) -> IO (Maybe String))
-> IO (Memoized (Maybe String)) -> IO (Maybe String)
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
""
    Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
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
-> (String -> Maybe Version) -> Maybe String -> Maybe Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Version
forall a. Maybe a
Nothing String -> Maybe Version
parseVersion' ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (String -> [String]
lines String
ver))

-- | Use dpkg -S to convert the executable path to a debian binary
-- package name.
hcBinPkgName :: FilePath -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName :: String -> IO (Memoized (Maybe BinPkgName))
hcBinPkgName String
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
  String
s <- String -> [String] -> String -> IO String
readProcess String
"dpkg" [String
"-S", String
path] String
""
  Maybe BinPkgName -> IO (Maybe BinPkgName)
forall a. a -> IO a
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 (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')) (String -> [String]
lines String
s) of
    [] -> Maybe BinPkgName
forall a. Maybe a
Nothing
    [String
name] -> BinPkgName -> Maybe BinPkgName
forall a. a -> Maybe a
Just (String -> BinPkgName
BinPkgName String
name)
    [String]
_ -> String -> Maybe BinPkgName
forall a. HasCallStack => String -> a
error (String -> Maybe BinPkgName) -> String -> Maybe BinPkgName
forall a b. (a -> b) -> a -> b
$ String
"Unexpected output from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
"dpkg" [String
"-S", String
path] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ++ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s

-- | What built in libraries does this haskell compiler provide?
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 =
    (String -> Maybe PackageIdentifier)
-> [String] -> [PackageIdentifier]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe PackageIdentifier
parsePackageIdentifier' ([String] -> [PackageIdentifier])
-> ([String] -> [String]) -> [String] -> [PackageIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([String] -> Maybe String) -> [[String]] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe String
dropRequiredSuffix String
".conf" (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. HasCallStack => [a] -> a
last) ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"package.conf.d") ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char -> Bool) -> String -> [String]
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
'/'))) ([String] -> [PackageIdentifier])
-> IO [String] -> IO [PackageIdentifier]
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') = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
suff) String
x in if String
suff String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
suff' then String -> Maybe String
forall a. a -> Maybe a
Just String
x' else Maybe String
forall a. Maybe a
Nothing

-- | A list of the files in a binary deb
binPkgFiles :: BinPkgName -> IO [FilePath]
binPkgFiles :: BinPkgName -> IO [String]
binPkgFiles BinPkgName
hcname = String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
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 =
    (SomeException -> [BinPkgName])
-> (String -> [BinPkgName])
-> Either SomeException String
-> [BinPkgName]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([BinPkgName] -> SomeException -> [BinPkgName]
forall a b. a -> b -> a
const []) ((String -> Maybe BinPkgName) -> [String] -> [BinPkgName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe BinPkgName
forall {source1}.
RegexContext Regex source1 (String, String, String, [String]) =>
source1 -> Maybe BinPkgName
doLine ([String] -> [BinPkgName])
-> (String -> [String]) -> String -> [BinPkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (Either SomeException String -> [BinPkgName])
-> IO (Either SomeException String) -> IO [BinPkgName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memoized (Either SomeException String)
-> IO (Either SomeException String)
forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized (Memoized (Either SomeException String)
 -> IO (Either SomeException String))
-> IO (Memoized (Either SomeException String))
-> IO (Either SomeException String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> IO (Memoized (Either SomeException String))
aptCacheDepends String
hcname (Doc -> String
forall a. Show a => a -> String
show (DebianVersion -> Doc
prettyDebianVersion DebianVersion
ver)))
    where
      doLine :: source1 -> Maybe BinPkgName
doLine source1
s = case source1
s source1 -> String -> (String, String, String, [String])
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]) -> BinPkgName -> Maybe BinPkgName
forall a. a -> Maybe a
Just (String -> BinPkgName
BinPkgName String
name)
                   (String, String, String, [String])
_ -> Maybe BinPkgName
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 =
    IO (Either SomeException String)
-> IO (Memoized (Either SomeException String))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar (IO String -> IO (Either SomeException String)
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver] String
""))

aptVersions :: BinPkgName -> IO [DebianVersion]
aptVersions :: BinPkgName -> IO [DebianVersion]
aptVersions =
    [DebianVersion] -> IO [DebianVersion]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DebianVersion] -> IO [DebianVersion])
-> (Either SomeException String -> [DebianVersion])
-> Either SomeException String
-> IO [DebianVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> [DebianVersion])
-> (String -> [DebianVersion])
-> Either SomeException String
-> [DebianVersion]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([DebianVersion] -> SomeException -> [DebianVersion]
forall a b. a -> b -> a
const []) ((String -> DebianVersion) -> [String] -> [DebianVersion]
forall a b. (a -> b) -> [a] -> [b]
map String -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' ([String] -> [DebianVersion])
-> (String -> [String]) -> String -> [DebianVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"Reverse Depends:") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"Versions:") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (Either SomeException String -> IO [DebianVersion])
-> (BinPkgName -> IO (Either SomeException String))
-> BinPkgName
-> IO [DebianVersion]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Memoized (Either SomeException String)
-> IO (Either SomeException String)
forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized (Memoized (Either SomeException String)
 -> IO (Either SomeException String))
-> (BinPkgName -> IO (Memoized (Either SomeException String)))
-> BinPkgName
-> IO (Either SomeException String)
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 =
    IO (Either SomeException String)
-> IO (Memoized (Either SomeException String))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar (IO String -> IO (Either SomeException String)
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
""))

-- | A package identifier is a package name followed by a dash and
-- then a version number.  A package name, according to the cabal
-- users guide "can use letters, numbers and hyphens, but not spaces."
-- So be it.
parsePackageIdentifier :: ReadP PackageIdentifier
parsePackageIdentifier :: ReadP PackageIdentifier
parsePackageIdentifier =
  ([String], Version) -> PackageIdentifier
makeId (([String], Version) -> PackageIdentifier)
-> ReadP ([String], Version) -> ReadP PackageIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) ([String] -> Version -> ([String], Version))
-> ReadP [String] -> ReadP (Version -> ([String], Version))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP String -> ReadP Char -> ReadP [String]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
endBy1 ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isAlphaNum) (Char -> ReadP Char
char Char
'-') ReadP (Version -> ([String], Version))
-> ReadP Version -> ReadP ([String], Version)
forall a b. ReadP (a -> b) -> ReadP a -> ReadP b
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 (String -> [String] -> String
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 = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (String -> [a]) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, String) -> a) -> [(a, String)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> a
forall a b. (a, b) -> a
fst ([(a, String)] -> [a])
-> (String -> [(a, String)]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) ([(a, String)] -> [(a, String)])
-> (String -> [(a, String)]) -> String -> [(a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP a -> String -> [(a, String)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
p

parseVersion' :: String -> Maybe Version
parseVersion' :: String -> Maybe Version
parseVersion' = ReadP Version -> String -> Maybe Version
forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP Version
parseCabalVersion

parseCabalVersion :: ReadP Version
parseCabalVersion :: ReadP Version
parseCabalVersion = (Version -> Version) -> ReadP Version -> ReadP Version
forall a b. (a -> b) -> ReadP a -> ReadP b
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' = ReadP PackageIdentifier -> String -> Maybe PackageIdentifier
forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier

tests :: Test
tests :: Test
tests = [Test] -> Test
TestList [ Assertion -> Test
TestCase (String
-> Maybe PackageIdentifier -> Maybe PackageIdentifier -> Assertion
forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Bundled1"
                               (PackageIdentifier -> Maybe PackageIdentifier
forall a. a -> Maybe a
Just (PackageName -> Version -> PackageIdentifier
PackageIdentifier (String -> PackageName
mkPackageName String
"HUnit") ([Int] -> Version
mkVersion [Int
1,Int
2,Int
3])))
                               (ReadP PackageIdentifier -> String -> Maybe PackageIdentifier
forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier String
"HUnit-1.2.3"))
                 , Assertion -> Test
TestCase (String
-> Maybe PackageIdentifier -> Maybe PackageIdentifier -> Assertion
forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Bundled2"
                               Maybe PackageIdentifier
forall a. Maybe a
Nothing
                               (ReadP PackageIdentifier -> String -> Maybe PackageIdentifier
forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP PackageIdentifier
parsePackageIdentifier String
"HUnit-1.2.3 "))
                 , Assertion -> Test
TestCase (Assertion -> Test) -> Assertion -> Test
forall a b. (a -> b) -> a -> b
$ do
                     String
verstr <- [String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"ghc" [String
"--numeric-version"] String
""
                     let ver :: Maybe String
ver = String -> Maybe String
forall a. a -> Maybe a
Just String
verstr
                     [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 (String -> BinPkgName
BinPkgName (String
"ghc"))
                     let expected :: Set String
expected = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
                                -- This is the package list for ghc-7.10.3
                                [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 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ((PackageIdentifier -> String) -> [PackageIdentifier] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName -> String
unPackageName (PackageName -> String)
-> (PackageIdentifier -> PackageName)
-> PackageIdentifier
-> String
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") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db"]
                         missing (Just String
"8.0.2") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db"]
                         missing (Just String
"9.0.2") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db", String
"hoopl"]
                         missing (Just String
"9.4.6") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"bin-package-db", String
"hoopl"]
                         missing Maybe String
_ = Set String
forall a. Monoid a => a
mempty
                         extra :: Maybe String -> Set String
extra (Just String
"7.8.4") = [String] -> Set String
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") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"ghc-boot",String
"ghc-boot-th",String
"ghci"]
                         extra (Just String
"8.0.2") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"ghc-boot",String
"ghc-boot-th",String
"ghci"]
                         extra (Just String
"9.0.2") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"exceptions", String
"ghc-bignum", String
"ghc-boot", String
"ghc-boot-th", String
"ghc-compact", String
"ghc-heap", String
"ghci", String
"libiserv", String
"mtl", String
"parsec", String
"stm", String
"text"]
                         extra (Just String
"9.4.6") = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"exceptions", String
"ghc-bignum", String
"ghc-boot", String
"ghc-boot-th", String
"ghc-compact", String
"ghc-heap", String
"ghci", String
"libiserv", String
"mtl", String
"parsec", String
"stm", String
"text"]
                         extra Maybe String
_ = Set String
forall a. Monoid a => a
mempty
                     String
-> (Set String, Set String)
-> (Set String, Set String)
-> Assertion
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)
                       (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set String
expected Set String
actual, Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set String
actual Set String
expected)
                 ]