module Debian.Package.Data.Source
( DebianVersion, versionFromHackageVersion, readDebianVersion, origVersion', isNative'
, Source, mkSource, sourceName, version, origVersion, isNative
, origArchiveName, nativeArchiveName, sourceDirName, deriveHackageVersion
, parseChangeLog
, HaskellPackage, hackage, package
, haskellPackageDefault, haskellPackageFromPackage
) where
import Data.Maybe (listToMaybe)
import Control.Arrow (second)
import Control.Monad (ap, MonadPlus, mplus)
import Numeric (readDec)
import Data.Char (isSpace)
import Data.Version (Version (Version, versionBranch), showVersion, parseVersion)
import Text.ParserCombinators.ReadP (ReadP, string, readP_to_S, readS_to_P)
import System.FilePath ((<.>))
import Debian.Package.Data.Hackage
(HackageVersion, mkHackageVersion, hackageVersionNumbers,
Hackage, mkHackageDefault, NameRule (Simple), debianNamesFromSourceName)
(<$>) :: Functor m => (a -> b) -> m a -> m b
(<$>) = fmap
pure :: Monad m => a -> m a
pure = return
(<*>) :: Monad m => m (a -> b) -> m a -> m b
(<*>) = ap
(*>) :: Monad m => m a -> m b -> m b
(*>) = (>>)
(<|>) :: MonadPlus m => m a -> m a -> m a
(<|>) = mplus
infixl 3 <|>
infixl 4 <$>, <*>, *>
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 [v0, v1, v2, v3] rev
d Nothing = debianNativeVersion [v0, v1, v2, v3] Nothing
(v0, v1, v2, v3) = 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 :: ReadP a -> String -> ReadP a
returnParsed p s = case [ x | (x, "") <- readP_to_S p s ] of
[x] -> return x
[] -> fail "ReadP: no parse"
_ -> fail "ReadP: ambiguous parse"
returnParsedVersion :: String -> ReadP Version
returnParsedVersion = returnParsed parseVersion
returnParsedNMU :: String -> ReadP (Maybe Int)
returnParsedNMU = returnParsed $
Just <$> (string "+nmu" *> readS_to_P readDec) <|>
pure Nothing
parseDebianVersion :: ReadP DebianVersion
parseDebianVersion = do
vs0 <- 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 _ = readP_to_S 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 -> Maybe HackageVersion
deriveHackageVersion = d . versionBranch . origVersion where
d [v0, v1, v2, v3] = Just $ mkHackageVersion v0 v1 v2 v3
d _ = Nothing
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 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
-> Either String HaskellPackage
haskellPackageFromPackage hname pkg = do
hv <- maybe (Left "Fail to derive hackage version") Right
$ deriveHackageVersion pkg
let hkg = mkHackageDefault Simple hname hv
return $ HaskellPackage hkg pkg