module Debian.Debianize.Types.VersionSplits
( VersionSplits
, packageRangesFromVersionSplits
, makePackage
, insertSplit
, doSplits
, knownVersionSplits
) where
import Data.Version (Version(Version), showVersion)
import Debian.Debianize.Interspersed (Interspersed(leftmost, pairs, foldInverted), foldTriples)
import Data.Map as Map (Map, fromList)
import Debian.Orphans ()
import qualified Debian.Relation as D
import Debian.Version (parseDebianVersion)
import Distribution.Package (PackageName(PackageName))
import Distribution.Version (VersionRange, anyVersion, intersectVersionRanges, earlierVersion, orLaterVersion)
import Prelude hiding (init, unlines, log)
data VersionSplits
= VersionSplits {
oldestPackage :: String
, splits :: [(Version, String)]
} deriving (Eq, Ord, Show)
makePackage :: String -> VersionSplits
makePackage name = VersionSplits {oldestPackage = name, splits = []}
insertSplit :: Version -> String -> VersionSplits -> VersionSplits
insertSplit ver@(Version _ _) ltname sp@(VersionSplits {}) =
case splits sp of
(ver', _) : _ | ver' > ver -> sp {oldestPackage = ltname, splits = (ver, oldestPackage sp) : splits sp}
[] -> sp {oldestPackage = ltname, splits = [(ver, oldestPackage sp)]}
_ -> sp {splits = reverse (insert (reverse (splits sp)))}
where
insert ((ver', name') : more) =
if ver' < ver
then (ver, name') : (ver', ltname) : more
else (ver', name') : insert more
insert [] = [(ver, oldestPackage sp)]
instance Interspersed VersionSplits String Version where
leftmost (VersionSplits {splits = []}) = error "Empty Interspersed instance"
leftmost (VersionSplits {oldestPackage = p}) = p
pairs (VersionSplits {splits = xs}) = xs
packageRangesFromVersionSplits :: VersionSplits -> [(String, VersionRange)]
packageRangesFromVersionSplits s =
foldInverted (\ older dname newer more ->
(dname, intersectVersionRanges (maybe anyVersion orLaterVersion older) (maybe anyVersion earlierVersion newer)) : more)
[]
s
doSplits :: VersionSplits -> Maybe D.VersionReq -> String
doSplits s version =
foldTriples' (\ ltName v geName _ ->
let split = parseDebianVersion (showVersion v) in
case version of
Nothing -> geName
Just (D.SLT v') | v' <= split -> ltName
Just (D.EEQ v') | v' < split -> ltName
Just (D.LTE v') | v' < split -> ltName
Just (D.GRE v') | v' < split -> ltName
Just (D.SGR v') | v' < split -> ltName
_ -> geName)
(oldestPackage s)
s
where
foldTriples' :: (String -> Version -> String -> String -> String) -> String -> VersionSplits -> String
foldTriples' = foldTriples
knownVersionSplits :: Map PackageName VersionSplits
knownVersionSplits =
Map.fromList
[ (PackageName "parsec", VersionSplits {oldestPackage = "parsec2", splits = [(Version [3] [], "parsec3")]})
, (PackageName "QuickCheck", VersionSplits {oldestPackage = "quickcheck1", splits = [(Version [2] [], "quickcheck2")]})
, (PackageName "gtk2hs-buildtools", VersionSplits {oldestPackage = "gtk2hs-buildtools", splits = []}) ]