module Debian.Package.Data.Source
( DebianVersion, versionFromHackageVersion, readDebianVersion, origVersion', isNative'
, Source, mkSource, sourceName, version, origVersion, isNative
, origArchiveName, nativeArchiveName, sourceDirName, deriveHackageVersion
, parseChangeLog
, ChangesType (..), takeChangesType, isSourceChanges, isBinaryChanges
, HaskellPackage, hackage, package
, haskellPackageDefault, haskellPackageFromPackage
) where
import Control.Arrow (second)
import Control.Applicative ((<$>), pure, (<*>), (<|>))
import Control.Monad.Trans.State (StateT, runStateT)
import Control.Monad.Trans.Class (lift)
import Numeric (readDec)
import Data.Maybe (listToMaybe)
import Data.Char (isSpace)
import Data.Version (Version (Version, versionBranch), showVersion, parseVersion)
import Data.List.Split (splitOn)
import Text.ParserCombinators.ReadP (ReadP, string, readP_to_S, readS_to_P)
import System.FilePath ((<.>), takeFileName, splitExtension)
import Debian.Package.Data.Hackage
(HackageVersion, mkHackageVersion', hackageVersionNumbers,
Hackage, mkHackageDefault, NameRule (Simple), debianNamesFromSourceName)
type Parser = StateT () ReadP
runParser :: Parser a -> String -> [(a, String)]
runParser p in0 = [ (x, in1) | ((x, ()), in1) <- readP_to_S (runStateT p ()) in0 ]
data DebianVersion
= DebianNative Version (Maybe Int)
| DebianNonNative Version String
debianNativeVersion :: [Int] -> Maybe Int -> DebianVersion
debianNativeVersion v = DebianNative (Version v [])
debianNonNativeVersion :: [Int] -> String -> DebianVersion
debianNonNativeVersion v = DebianNonNative (Version v [])
versionFromHackageVersion :: HackageVersion -> Maybe String -> DebianVersion
versionFromHackageVersion hv = d where
d (Just rev) = debianNonNativeVersion ns rev
d Nothing = debianNativeVersion ns Nothing
ns = hackageVersionNumbers hv
origVersion' :: DebianVersion -> Version
origVersion' = d where
d (DebianNative v _) = v
d (DebianNonNative v _) = v
isNative' :: DebianVersion -> Bool
isNative' = d where
d (DebianNative _ _) = True
d (DebianNonNative _ _) = False
lexWord :: String -> [(String, String)]
lexWord = (:[]) . break isSpace . dropWhile isSpace
returnParsed :: Parser a -> String -> Parser a
returnParsed p s = case [ x | (x, "") <- runParser p s ] of
[x] -> return x
[] -> fail "ReadP: no parse"
_ -> fail "ReadP: ambiguous parse"
returnParsedVersion :: String -> Parser Version
returnParsedVersion = returnParsed $ lift parseVersion
returnParsedNMU :: String -> Parser (Maybe Int)
returnParsedNMU = returnParsed $
Just <$> lift (string "+nmu" >> readS_to_P readDec) <|>
pure Nothing
parseDebianVersion :: Parser DebianVersion
parseDebianVersion = do
vs0 <- lift $ readS_to_P lexWord
let (vs1, rtag) = break (== '-') vs0
(vs2, nmu) = break (== '+') vs1
if rtag == ""
then DebianNative <$> returnParsedVersion vs2 <*> returnParsedNMU nmu
else DebianNonNative <$> returnParsedVersion vs1 <*> return (tail rtag)
instance Show DebianVersion where
show = d where
d (DebianNative v nr) = showVersion v ++ maybe "" (("+nmu" ++) . show) nr
d (DebianNonNative v r) = showVersion v ++ '-': r
instance Read DebianVersion where
readsPrec _ = runParser parseDebianVersion
readMaybe' :: Read a => String -> Maybe a
readMaybe' = fmap fst . listToMaybe . filter ((== "") . snd) . reads
readDebianVersion :: String -> Maybe DebianVersion
readDebianVersion = readMaybe'
data Source = Source String DebianVersion deriving Show
mkSource :: String -> DebianVersion -> Source
mkSource = Source
sourceName :: Source -> String
sourceName (Source n _) = n
version :: Source -> DebianVersion
version (Source _ v) = v
origVersion :: Source -> Version
origVersion = origVersion' . version
isNative :: Source -> Bool
isNative = isNative' . version
origArchiveName :: Source -> FilePath
origArchiveName pkg = sourceName pkg ++ '_' : showVersion (origVersion pkg) <.> "orig" <.> "tar" <.> "gz"
nativeArchiveName :: Source -> String
nativeArchiveName pkg = sourceName pkg ++ '_' : show (version pkg) <.> "tar" <.> "gz"
sourceDirName :: Source -> FilePath
sourceDirName pkg = sourceName pkg ++ '-' : showVersion (origVersion pkg)
deriveHackageVersion :: Source -> HackageVersion
deriveHackageVersion = mkHackageVersion' . versionBranch . origVersion where
parseChangeLog :: String
-> Maybe Source
parseChangeLog log' = do
deb <- mayDebSrc
dver <- mayDebVer
return $ mkSource deb dver
where
pairs = map (second tail . break (== ' ')) . lines $ log'
lookup' = (`lookup` pairs)
mayDebSrc = lookup' "Source:"
mayDebVer = do
dverS <- lookup' "Version:"
readDebianVersion dverS
data ChangesType
= ChangesArch String
| ChangesAll
| ChangesSource
deriving (Eq, Show)
takeChangesType :: FilePath -> Maybe ChangesType
takeChangesType path = d . splitExtension $ takeFileName path where
d (n, ".changes") = case xs of
[_, _, a] -> case a of
"all" -> Just ChangesAll
"source" -> Just ChangesSource
_ -> Just $ ChangesArch a
_ -> Nothing
where xs = splitOn "_" n
d (_, _) = Nothing
isSourceChanges :: ChangesType -> Bool
isSourceChanges = d where
d (ChangesArch _) = False
d ChangesAll = False
d ChangesSource = True
isBinaryChanges :: ChangesType -> Bool
isBinaryChanges = not . isSourceChanges
data HaskellPackage = HaskellPackage Hackage Source deriving Show
hackage :: HaskellPackage -> Hackage
hackage (HaskellPackage h _) = h
package :: HaskellPackage -> Source
package (HaskellPackage _ p) = p
haskellPackageDefault :: NameRule
-> String
-> HackageVersion
-> Maybe String
-> HaskellPackage
haskellPackageDefault rule hname hver mayDevRev =
HaskellPackage
(mkHackageDefault rule hname hver)
(mkSource sn (versionFromHackageVersion hver mayDevRev))
where
(sn, _) = debianNamesFromSourceName rule hname
haskellPackageFromPackage :: String
-> Source
-> HaskellPackage
haskellPackageFromPackage hname pkg = HaskellPackage hkg pkg where
hv = deriveHackageVersion pkg
hkg = mkHackageDefault Simple hname hv