-- | Convert between cabal and debian package names based on version
-- number ranges.
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
module Debian.Debianize.VersionSplits
    ( DebBase(DebBase, unDebBase)
    -- * Combinators for VersionSplits
    , VersionSplits(..)
    , makePackage
    , insertSplit
    -- * Operators on VersionSplits
    , cabalFromDebian
    , cabalFromDebian'
    , debianFromCabal
    , packageRangesFromVersionSplits
    , doSplits
    ) where

import Data.Generics (Data, Typeable)
import Data.Map as Map (elems, Map, mapMaybeWithKey)
import Data.Set as Set (fromList, Set, toList)
import Debian.Debianize.Interspersed (foldTriples, Interspersed(leftmost, pairs, foldInverted))
import Debian.Orphans ()
import qualified Debian.Relation as D (VersionReq(..))
import Debian.Version (DebianVersion, parseDebianVersion')
import Distribution.Package (PackageIdentifier(..), PackageName)
import Distribution.Package (mkPackageName)
import Distribution.Pretty (prettyShow)
import Distribution.Version (Version)
import Distribution.Version (anyVersion, earlierVersion, intersectVersionRanges, orLaterVersion, VersionRange)
import Prelude hiding (init, log, unlines)

-- | The base of a debian binary package name, the string that appears
-- between "libghc-" and "-dev".
newtype DebBase = DebBase {DebBase -> String
unDebBase :: String} deriving (DebBase -> DebBase -> Bool
(DebBase -> DebBase -> Bool)
-> (DebBase -> DebBase -> Bool) -> Eq DebBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebBase -> DebBase -> Bool
$c/= :: DebBase -> DebBase -> Bool
== :: DebBase -> DebBase -> Bool
$c== :: DebBase -> DebBase -> Bool
Eq, Eq DebBase
Eq DebBase
-> (DebBase -> DebBase -> Ordering)
-> (DebBase -> DebBase -> Bool)
-> (DebBase -> DebBase -> Bool)
-> (DebBase -> DebBase -> Bool)
-> (DebBase -> DebBase -> Bool)
-> (DebBase -> DebBase -> DebBase)
-> (DebBase -> DebBase -> DebBase)
-> Ord DebBase
DebBase -> DebBase -> Bool
DebBase -> DebBase -> Ordering
DebBase -> DebBase -> DebBase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebBase -> DebBase -> DebBase
$cmin :: DebBase -> DebBase -> DebBase
max :: DebBase -> DebBase -> DebBase
$cmax :: DebBase -> DebBase -> DebBase
>= :: DebBase -> DebBase -> Bool
$c>= :: DebBase -> DebBase -> Bool
> :: DebBase -> DebBase -> Bool
$c> :: DebBase -> DebBase -> Bool
<= :: DebBase -> DebBase -> Bool
$c<= :: DebBase -> DebBase -> Bool
< :: DebBase -> DebBase -> Bool
$c< :: DebBase -> DebBase -> Bool
compare :: DebBase -> DebBase -> Ordering
$ccompare :: DebBase -> DebBase -> Ordering
$cp1Ord :: Eq DebBase
Ord, ReadPrec [DebBase]
ReadPrec DebBase
Int -> ReadS DebBase
ReadS [DebBase]
(Int -> ReadS DebBase)
-> ReadS [DebBase]
-> ReadPrec DebBase
-> ReadPrec [DebBase]
-> Read DebBase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebBase]
$creadListPrec :: ReadPrec [DebBase]
readPrec :: ReadPrec DebBase
$creadPrec :: ReadPrec DebBase
readList :: ReadS [DebBase]
$creadList :: ReadS [DebBase]
readsPrec :: Int -> ReadS DebBase
$creadsPrec :: Int -> ReadS DebBase
Read, Int -> DebBase -> ShowS
[DebBase] -> ShowS
DebBase -> String
(Int -> DebBase -> ShowS)
-> (DebBase -> String) -> ([DebBase] -> ShowS) -> Show DebBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebBase] -> ShowS
$cshowList :: [DebBase] -> ShowS
show :: DebBase -> String
$cshow :: DebBase -> String
showsPrec :: Int -> DebBase -> ShowS
$cshowsPrec :: Int -> DebBase -> ShowS
Show, Typeable DebBase
DataType
Constr
Typeable DebBase
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DebBase -> c DebBase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DebBase)
-> (DebBase -> Constr)
-> (DebBase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DebBase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebBase))
-> ((forall b. Data b => b -> b) -> DebBase -> DebBase)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DebBase -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DebBase -> r)
-> (forall u. (forall d. Data d => d -> u) -> DebBase -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DebBase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DebBase -> m DebBase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DebBase -> m DebBase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DebBase -> m DebBase)
-> Data DebBase
DebBase -> DataType
DebBase -> Constr
(forall b. Data b => b -> b) -> DebBase -> DebBase
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebBase -> c DebBase
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebBase
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DebBase -> u
forall u. (forall d. Data d => d -> u) -> DebBase -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DebBase -> m DebBase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebBase -> m DebBase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebBase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebBase -> c DebBase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DebBase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebBase)
$cDebBase :: Constr
$tDebBase :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DebBase -> m DebBase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebBase -> m DebBase
gmapMp :: (forall d. Data d => d -> m d) -> DebBase -> m DebBase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebBase -> m DebBase
gmapM :: (forall d. Data d => d -> m d) -> DebBase -> m DebBase
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DebBase -> m DebBase
gmapQi :: Int -> (forall d. Data d => d -> u) -> DebBase -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DebBase -> u
gmapQ :: (forall d. Data d => d -> u) -> DebBase -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DebBase -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebBase -> r
gmapT :: (forall b. Data b => b -> b) -> DebBase -> DebBase
$cgmapT :: (forall b. Data b => b -> b) -> DebBase -> DebBase
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebBase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebBase)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DebBase)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DebBase)
dataTypeOf :: DebBase -> DataType
$cdataTypeOf :: DebBase -> DataType
toConstr :: DebBase -> Constr
$ctoConstr :: DebBase -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebBase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebBase
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebBase -> c DebBase
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebBase -> c DebBase
$cp1Data :: Typeable DebBase
Data, Typeable)

-- | Describes a mapping from cabal package name and version to debian
-- package names.  For example, versions of the cabal QuickCheck
-- package less than 2 are mapped to "quickcheck1", while version 2 or
-- greater is mapped to "quickcheck2".
data VersionSplits
    = VersionSplits {
        VersionSplits -> DebBase
oldestPackage :: DebBase
      -- ^ The Debian name given to versions older than the oldest split.
      , VersionSplits -> [(Version, DebBase)]
splits :: [(Version, DebBase)]
      -- ^ Each pair is The version where the split occurs, and the
      -- name to use for versions greater than or equal to that
      -- version.  This list assumed to be in (must be kept in)
      -- descending version number order, newest to oldest
      } deriving (VersionSplits -> VersionSplits -> Bool
(VersionSplits -> VersionSplits -> Bool)
-> (VersionSplits -> VersionSplits -> Bool) -> Eq VersionSplits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionSplits -> VersionSplits -> Bool
$c/= :: VersionSplits -> VersionSplits -> Bool
== :: VersionSplits -> VersionSplits -> Bool
$c== :: VersionSplits -> VersionSplits -> Bool
Eq, Eq VersionSplits
Eq VersionSplits
-> (VersionSplits -> VersionSplits -> Ordering)
-> (VersionSplits -> VersionSplits -> Bool)
-> (VersionSplits -> VersionSplits -> Bool)
-> (VersionSplits -> VersionSplits -> Bool)
-> (VersionSplits -> VersionSplits -> Bool)
-> (VersionSplits -> VersionSplits -> VersionSplits)
-> (VersionSplits -> VersionSplits -> VersionSplits)
-> Ord VersionSplits
VersionSplits -> VersionSplits -> Bool
VersionSplits -> VersionSplits -> Ordering
VersionSplits -> VersionSplits -> VersionSplits
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionSplits -> VersionSplits -> VersionSplits
$cmin :: VersionSplits -> VersionSplits -> VersionSplits
max :: VersionSplits -> VersionSplits -> VersionSplits
$cmax :: VersionSplits -> VersionSplits -> VersionSplits
>= :: VersionSplits -> VersionSplits -> Bool
$c>= :: VersionSplits -> VersionSplits -> Bool
> :: VersionSplits -> VersionSplits -> Bool
$c> :: VersionSplits -> VersionSplits -> Bool
<= :: VersionSplits -> VersionSplits -> Bool
$c<= :: VersionSplits -> VersionSplits -> Bool
< :: VersionSplits -> VersionSplits -> Bool
$c< :: VersionSplits -> VersionSplits -> Bool
compare :: VersionSplits -> VersionSplits -> Ordering
$ccompare :: VersionSplits -> VersionSplits -> Ordering
$cp1Ord :: Eq VersionSplits
Ord, Typeable VersionSplits
DataType
Constr
Typeable VersionSplits
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VersionSplits -> c VersionSplits)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VersionSplits)
-> (VersionSplits -> Constr)
-> (VersionSplits -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VersionSplits))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VersionSplits))
-> ((forall b. Data b => b -> b) -> VersionSplits -> VersionSplits)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionSplits -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionSplits -> r)
-> (forall u. (forall d. Data d => d -> u) -> VersionSplits -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VersionSplits -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits)
-> Data VersionSplits
VersionSplits -> DataType
VersionSplits -> Constr
(forall b. Data b => b -> b) -> VersionSplits -> VersionSplits
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionSplits -> c VersionSplits
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionSplits
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> VersionSplits -> u
forall u. (forall d. Data d => d -> u) -> VersionSplits -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionSplits
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionSplits -> c VersionSplits
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VersionSplits)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionSplits)
$cVersionSplits :: Constr
$tVersionSplits :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
gmapMp :: (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
gmapM :: (forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VersionSplits -> m VersionSplits
gmapQi :: Int -> (forall d. Data d => d -> u) -> VersionSplits -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VersionSplits -> u
gmapQ :: (forall d. Data d => d -> u) -> VersionSplits -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VersionSplits -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionSplits -> r
gmapT :: (forall b. Data b => b -> b) -> VersionSplits -> VersionSplits
$cgmapT :: (forall b. Data b => b -> b) -> VersionSplits -> VersionSplits
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionSplits)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionSplits)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VersionSplits)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VersionSplits)
dataTypeOf :: VersionSplits -> DataType
$cdataTypeOf :: VersionSplits -> DataType
toConstr :: VersionSplits -> Constr
$ctoConstr :: VersionSplits -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionSplits
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionSplits
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionSplits -> c VersionSplits
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VersionSplits -> c VersionSplits
$cp1Data :: Typeable VersionSplits
Data, Typeable)

instance Show VersionSplits where
    show :: VersionSplits -> String
show VersionSplits
s = ((Version, DebBase) -> ShowS)
-> String -> [(Version, DebBase)] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (Version
v, DebBase
b) String
r -> (String
"insertSplit (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DebBase -> String
forall a. Show a => a -> String
show DebBase
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")) (String
"makePackage (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DebBase -> String
forall a. Show a => a -> String
show (VersionSplits -> DebBase
oldestPackage VersionSplits
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") (VersionSplits -> [(Version, DebBase)]
splits VersionSplits
s)

instance Interspersed VersionSplits DebBase Version where
    leftmost :: VersionSplits -> DebBase
leftmost (VersionSplits {oldestPackage :: VersionSplits -> DebBase
oldestPackage = DebBase
p}) = DebBase
p
    pairs :: VersionSplits -> [(Version, DebBase)]
pairs (VersionSplits {splits :: VersionSplits -> [(Version, DebBase)]
splits = [(Version, DebBase)]
xs}) = [(Version, DebBase)]
xs

-- | Create a version split database that assigns a single debian
-- package name base to all cabal versions.
makePackage :: DebBase -> VersionSplits
makePackage :: DebBase -> VersionSplits
makePackage DebBase
name = VersionSplits :: DebBase -> [(Version, DebBase)] -> VersionSplits
VersionSplits {oldestPackage :: DebBase
oldestPackage = DebBase
name, splits :: [(Version, DebBase)]
splits = []}

-- | Split the version range and give the older packages a new name.
insertSplit :: Version -- ^ Where to split the version range
            -> DebBase -- ^ The name to use for versions older than the split
            -> VersionSplits
            -> VersionSplits
insertSplit :: Version -> DebBase -> VersionSplits -> VersionSplits
insertSplit Version
ver DebBase
ltname sp :: VersionSplits
sp@(VersionSplits {}) =
    -- (\ x -> trace ("insertSplit " ++ show (ltname, ver, sp) ++ " -> " ++ show x) x) $
    case VersionSplits -> [(Version, DebBase)]
splits VersionSplits
sp of
      -- This is the oldest split, change oldestPackage and insert a new head pair
      (Version
ver', DebBase
_) : [(Version, DebBase)]
_ | Version
ver' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
ver -> VersionSplits
sp {oldestPackage :: DebBase
oldestPackage = DebBase
ltname, splits :: [(Version, DebBase)]
splits = (Version
ver, VersionSplits -> DebBase
oldestPackage VersionSplits
sp) (Version, DebBase) -> [(Version, DebBase)] -> [(Version, DebBase)]
forall a. a -> [a] -> [a]
: VersionSplits -> [(Version, DebBase)]
splits VersionSplits
sp}
      (Version
ver', DebBase
name) : [(Version, DebBase)]
_ | Version
ver' Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
ver Bool -> Bool -> Bool
&& DebBase
name DebBase -> DebBase -> Bool
forall a. Eq a => a -> a -> Bool
== DebBase
ltname -> VersionSplits
sp
      [] -> VersionSplits
sp {oldestPackage :: DebBase
oldestPackage = DebBase
ltname, splits :: [(Version, DebBase)]
splits = [(Version
ver, VersionSplits -> DebBase
oldestPackage VersionSplits
sp)]}
      -- Not the oldest split, insert it in its proper place.
      [(Version, DebBase)]
_ -> VersionSplits
sp {splits :: [(Version, DebBase)]
splits = [(Version, DebBase)] -> [(Version, DebBase)]
forall a. [a] -> [a]
reverse ([(Version, DebBase)] -> [(Version, DebBase)]
insert ([(Version, DebBase)] -> [(Version, DebBase)]
forall a. [a] -> [a]
reverse (VersionSplits -> [(Version, DebBase)]
splits VersionSplits
sp)))}
    where
      -- Insert our new split into the reversed list
      insert :: [(Version, DebBase)] -> [(Version, DebBase)]
insert ((Version
ver', DebBase
name') : [(Version, DebBase)]
more) =
          if Version
ver' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
ver
          then (Version
ver, DebBase
name') (Version, DebBase) -> [(Version, DebBase)] -> [(Version, DebBase)]
forall a. a -> [a] -> [a]
: (Version
ver', DebBase
ltname) (Version, DebBase) -> [(Version, DebBase)] -> [(Version, DebBase)]
forall a. a -> [a] -> [a]
: [(Version, DebBase)]
more
          else (Version
ver', DebBase
name') (Version, DebBase) -> [(Version, DebBase)] -> [(Version, DebBase)]
forall a. a -> [a] -> [a]
: [(Version, DebBase)] -> [(Version, DebBase)]
insert [(Version, DebBase)]
more
      -- ver' is older, change oldestPackage
      insert [] = [(Version
ver, VersionSplits -> DebBase
oldestPackage VersionSplits
sp)]
      -- ltname = base ++ "-" ++ (show (last ns - 1))

packageRangesFromVersionSplits :: VersionSplits -> [(DebBase, VersionRange)]
packageRangesFromVersionSplits :: VersionSplits -> [(DebBase, VersionRange)]
packageRangesFromVersionSplits VersionSplits
s =
    (Maybe Version
 -> DebBase
 -> Maybe Version
 -> [(DebBase, VersionRange)]
 -> [(DebBase, VersionRange)])
-> [(DebBase, VersionRange)]
-> VersionSplits
-> [(DebBase, VersionRange)]
forall t around between r.
Interspersed t around between =>
(Maybe between -> around -> Maybe between -> r -> r) -> r -> t -> r
foldInverted (\ Maybe Version
older DebBase
dname Maybe Version
newer [(DebBase, VersionRange)]
more ->
                      (DebBase
dname, VersionRange -> VersionRange -> VersionRange
intersectVersionRanges (VersionRange
-> (Version -> VersionRange) -> Maybe Version -> VersionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRange
anyVersion Version -> VersionRange
orLaterVersion Maybe Version
older) (VersionRange
-> (Version -> VersionRange) -> Maybe Version -> VersionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRange
anyVersion Version -> VersionRange
earlierVersion Maybe Version
newer)) (DebBase, VersionRange)
-> [(DebBase, VersionRange)] -> [(DebBase, VersionRange)]
forall a. a -> [a] -> [a]
: [(DebBase, VersionRange)]
more)
                 []
                 VersionSplits
s

debianFromCabal :: VersionSplits -> PackageIdentifier -> DebBase
debianFromCabal :: VersionSplits -> PackageIdentifier -> DebBase
debianFromCabal VersionSplits
s PackageIdentifier
p =
    VersionSplits -> Maybe VersionReq -> DebBase
doSplits VersionSplits
s (VersionReq -> Maybe VersionReq
forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.EEQ DebianVersion
debVer))
    where debVer :: DebianVersion
debVer = String -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (Version -> String
forall a. Pretty a => a -> String
prettyShow (PackageIdentifier -> Version
pkgVersion PackageIdentifier
p))

cabalFromDebian' :: Map PackageName VersionSplits -> DebBase -> Version -> PackageIdentifier
cabalFromDebian' :: Map PackageName VersionSplits
-> DebBase -> Version -> PackageIdentifier
cabalFromDebian' Map PackageName VersionSplits
mp DebBase
base Version
ver =
    PackageName -> Version -> PackageIdentifier
PackageIdentifier (Map PackageName VersionSplits
-> DebBase -> DebianVersion -> PackageName
cabalFromDebian Map PackageName VersionSplits
mp DebBase
base DebianVersion
dver) Version
ver
    where dver :: DebianVersion
dver = String -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver)

-- | Brute force implementation - I'm assuming this is not a huge map.
cabalFromDebian :: Map PackageName VersionSplits -> DebBase -> DebianVersion -> PackageName
cabalFromDebian :: Map PackageName VersionSplits
-> DebBase -> DebianVersion -> PackageName
cabalFromDebian Map PackageName VersionSplits
mp base :: DebBase
base@(DebBase String
name) DebianVersion
ver =
    case Set PackageName -> [PackageName]
forall a. Set a -> [a]
Set.toList Set PackageName
pset of
      [PackageName
x] -> PackageName
x
      [] -> String -> PackageName
mkPackageName String
name
      [PackageName]
l -> String -> PackageName
forall a. HasCallStack => String -> a
error (String -> PackageName) -> String -> PackageName
forall a b. (a -> b) -> a -> b
$ String
"Error, multiple cabal package names associated with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DebBase -> String
forall a. Show a => a -> String
show DebBase
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PackageName] -> String
forall a. Show a => a -> String
show [PackageName]
l
    where
      -- Look for splits that involve the right DebBase and return the
      -- associated Cabal package name.  It is unlikely that more than
      -- one Cabal name will be returned - if so throw an exception.
      pset :: Set PackageName
      pset :: Set PackageName
pset = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList ([PackageName] -> Set PackageName)
-> [PackageName] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ Map PackageName PackageName -> [PackageName]
forall k a. Map k a -> [a]
Map.elems (Map PackageName PackageName -> [PackageName])
-> Map PackageName PackageName -> [PackageName]
forall a b. (a -> b) -> a -> b
$
             (PackageName -> VersionSplits -> Maybe PackageName)
-> Map PackageName VersionSplits -> Map PackageName PackageName
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey
                (\ PackageName
p VersionSplits
s -> if VersionSplits -> Maybe VersionReq -> DebBase
doSplits VersionSplits
s (VersionReq -> Maybe VersionReq
forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.EEQ DebianVersion
ver)) DebBase -> DebBase -> Bool
forall a. Eq a => a -> a -> Bool
== DebBase
base then PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just PackageName
p else Maybe PackageName
forall a. Maybe a
Nothing)
                Map PackageName VersionSplits
mp

-- | Given a version split database, turn the debian version
-- requirements into a debian package name base that ought to satisfy
-- them.
doSplits :: VersionSplits -> Maybe D.VersionReq -> DebBase
doSplits :: VersionSplits -> Maybe VersionReq -> DebBase
doSplits VersionSplits
s Maybe VersionReq
version =
    (DebBase -> Version -> DebBase -> DebBase -> DebBase)
-> DebBase -> VersionSplits -> DebBase
foldTriples' (\ DebBase
ltName Version
v DebBase
geName DebBase
_ ->
                           let split :: DebianVersion
split = String -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (Version -> String
forall a. Pretty a => a -> String
prettyShow Version
v) in
                                case Maybe VersionReq
version of
                                  Maybe VersionReq
Nothing -> DebBase
geName
                                  Just (D.SLT DebianVersion
v') | DebianVersion
v' DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= DebianVersion
split -> DebBase
ltName
                                  -- Otherwise use ltName only when the split is below v'
                                  Just (D.EEQ DebianVersion
v') | DebianVersion
v' DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DebianVersion
split -> DebBase
ltName
                                  Just (D.LTE DebianVersion
v') | DebianVersion
v' DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DebianVersion
split -> DebBase
ltName
                                  Just (D.GRE DebianVersion
v') | DebianVersion
v' DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DebianVersion
split -> DebBase
ltName
                                  Just (D.SGR DebianVersion
v') | DebianVersion
v' DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DebianVersion
split -> DebBase
ltName
                                  Maybe VersionReq
_ -> DebBase
geName)
                 (VersionSplits -> DebBase
oldestPackage VersionSplits
s)
                 VersionSplits
s
    where
      foldTriples' :: (DebBase -> Version -> DebBase -> DebBase -> DebBase) -> DebBase -> VersionSplits -> DebBase
      foldTriples' :: (DebBase -> Version -> DebBase -> DebBase -> DebBase)
-> DebBase -> VersionSplits -> DebBase
foldTriples' = (DebBase -> Version -> DebBase -> DebBase -> DebBase)
-> DebBase -> VersionSplits -> DebBase
forall t around between r.
Interspersed t around between =>
(around -> between -> around -> r -> r) -> r -> t -> r
foldTriples