-- | 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, stripPrefix)
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 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

-- | 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 -> 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

-- | Use which(1) to determine full path name to haskell compiler executable
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))

-- | Use dpkg -S to convert the executable path to a debian binary
-- package name.
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

-- | 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 =
    (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

-- | A list of the files in a binary deb
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
""))

-- | 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 =
  ([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
                                -- This is the package list for ghc-7.10.3
                                [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)
                 ]