193 lines
7.0 KiB
Haskell
193 lines
7.0 KiB
Haskell
module SlackBuilder.Info
|
|
( PackageInfo(..)
|
|
, generate
|
|
, parseInfoFile
|
|
, update
|
|
, updateDownloadVersion
|
|
) where
|
|
|
|
import Control.Applicative (Alternative(..))
|
|
import Control.Monad.Combinators (sepBy)
|
|
import qualified Data.ByteArray as ByteArray
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as ByteString
|
|
import qualified Data.ByteString.Char8 as Char8
|
|
import qualified Data.List.NonEmpty as NonEmpty
|
|
import Data.Maybe (mapMaybe)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.Encoding as Text
|
|
import qualified Data.Text.Lazy as Lazy.Text
|
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
import qualified Data.Text.Lazy.Builder as Text (Builder)
|
|
import Crypto.Hash (Digest, MD5, digestFromByteString)
|
|
import Data.Void (Void)
|
|
import Data.Word (Word8)
|
|
import Numeric (readHex, showHex)
|
|
import Text.Megaparsec (Parsec, count, eof, takeWhile1P)
|
|
import Text.Megaparsec.Byte (space, string, hexDigitChar)
|
|
import Text.URI
|
|
( Authority(..)
|
|
, URI(..)
|
|
, mkPathPiece
|
|
, parserBs
|
|
, render
|
|
, unRText
|
|
)
|
|
import qualified Data.Word8 as Word8
|
|
|
|
type GenParser = Parsec Void ByteString
|
|
|
|
data PackageInfo = PackageInfo
|
|
{ pkgname :: String
|
|
, version :: Text
|
|
, homepage :: Text
|
|
, downloads :: [URI]
|
|
, checksums :: [Digest MD5]
|
|
, downloadX64 :: [URI]
|
|
, checksumX64 :: [Digest MD5]
|
|
, requires :: [ByteString]
|
|
, maintainer :: Text
|
|
, email :: Text
|
|
} deriving (Eq, Show)
|
|
|
|
variableEntry :: ByteString -> GenParser ByteString
|
|
variableEntry variable = string (Char8.append variable "=\"")
|
|
*> takeWhile1P Nothing (0x22 /=)
|
|
<* string "\"\n"
|
|
|
|
variableSeparator :: GenParser ()
|
|
variableSeparator = string " \\" *> space
|
|
|
|
packageDownloads :: ByteString -> GenParser [URI]
|
|
packageDownloads variableName = string (variableName <> "=\"")
|
|
*> sepBy parserBs variableSeparator
|
|
<* string "\"\n"
|
|
|
|
hexDigit :: GenParser Word8
|
|
hexDigit =
|
|
let digitPair = count 2 hexDigitChar
|
|
in fst . head . readHex . fmap (toEnum . fromIntegral) <$> digitPair
|
|
|
|
packageChecksum :: GenParser ByteString
|
|
packageChecksum = ByteString.pack <$> count 16 hexDigit
|
|
|
|
packageChecksums :: ByteString -> GenParser [ByteString]
|
|
packageChecksums variableName = string (variableName <> "=\"")
|
|
*> sepBy packageChecksum variableSeparator
|
|
<* string "\"\n"
|
|
|
|
packageRequires :: GenParser [ByteString]
|
|
packageRequires = string "REQUIRES=\""
|
|
*> sepBy (packageName <|> string "%README%") space
|
|
<* string "\"\n"
|
|
|
|
packageName :: GenParser ByteString
|
|
packageName = takeWhile1P Nothing isNameToken
|
|
where
|
|
isNameToken x = Word8.isAlphaNum x
|
|
|| x == Word8._hyphen
|
|
|| x == Word8._underscore
|
|
|
|
parseInfoFile :: GenParser PackageInfo
|
|
parseInfoFile = PackageInfo
|
|
<$> (Char8.unpack <$> packagePrgnam)
|
|
<*> (Text.decodeUtf8 <$> variableEntry "VERSION")
|
|
<*> (Text.decodeUtf8 <$> variableEntry "HOMEPAGE")
|
|
<*> packageDownloads "DOWNLOAD"
|
|
<*> (mapMaybe digestFromByteString <$> packageChecksums "MD5SUM")
|
|
<*> packageDownloads "DOWNLOAD_x86_64"
|
|
<*> (mapMaybe digestFromByteString <$> packageChecksums "MD5SUM_x86_64")
|
|
<*> packageRequires
|
|
<*> (Text.decodeUtf8 <$> variableEntry "MAINTAINER")
|
|
<*> (Text.decodeUtf8 <$> variableEntry "EMAIL")
|
|
<* eof
|
|
where
|
|
packagePrgnam = (string "PKGNAM" <|> string "PRGNAM")
|
|
>> string "=\""
|
|
*> packageName
|
|
<* "\"\n"
|
|
|
|
updateDownloadVersion :: PackageInfo -> Text -> Maybe String -> [URI]
|
|
updateDownloadVersion package toVersion gnomeVersion
|
|
= updateDownload (version package) toVersion gnomeVersion
|
|
<$> downloads package
|
|
|
|
updateDownload :: Text -> Text -> Maybe String -> URI -> URI
|
|
updateDownload fromVersion toVersion gnomeVersion
|
|
= updateCoreVersion fromVersion toVersion gnomeVersion
|
|
. updatePackageVersion fromVersion toVersion gnomeVersion
|
|
|
|
updatePackageVersion :: Text -> Text -> Maybe String -> URI -> URI
|
|
updatePackageVersion fromVersion toVersion _gnomeVersion download = download
|
|
{ uriPath = uriPath download >>= traverse (traverse updatePathPiece)
|
|
}
|
|
where
|
|
updatePathPiece = mkPathPiece
|
|
. Text.replace fromMajor toMajor
|
|
. Text.replace fromVersion toVersion
|
|
. unRText
|
|
fromMajor = major fromVersion
|
|
toMajor = major toVersion
|
|
|
|
major :: Text -> Text
|
|
major = Text.intercalate "." . take 2 . Text.splitOn "."
|
|
|
|
updateCoreVersion :: Text -> Text -> Maybe String -> URI -> URI
|
|
updateCoreVersion _fromVersion _toVersion (Just gnomeVersion) download
|
|
| Just (False, pathPieces) <- uriPath download
|
|
, (beforeCore, afterCore) <- NonEmpty.break (comparePathPiece "core") pathPieces
|
|
, _ : _ : _ : sources : afterSources <- afterCore
|
|
, comparePathPiece "sources" sources && not (null afterSources)
|
|
, Right Authority{..} <- uriAuthority download
|
|
, ".gnome.org" `Text.isSuffixOf` unRText authHost
|
|
, Nothing <- authPort =
|
|
download { uriPath = buildPath beforeCore afterSources }
|
|
where
|
|
comparePathPiece this that = Just that == mkPathPiece this
|
|
buildPath beforeCore afterSources = do
|
|
core <- mkPathPiece "core"
|
|
let textGnomeVersion = Text.pack gnomeVersion
|
|
minorGnomeVersion <- mkPathPiece $ major textGnomeVersion
|
|
patchGnomeVersion <- mkPathPiece textGnomeVersion
|
|
sources <- mkPathPiece "sources"
|
|
let afterCore = core : minorGnomeVersion : patchGnomeVersion : sources : afterSources
|
|
(False,) <$> NonEmpty.nonEmpty (beforeCore ++ afterCore)
|
|
updateCoreVersion _ _ _ download = download
|
|
|
|
update :: PackageInfo -> Text -> [URI] -> [Digest MD5] -> PackageInfo
|
|
update old toVersion downloads' checksums' = old
|
|
{ version = toVersion
|
|
, downloads = downloads'
|
|
, checksums = checksums'
|
|
}
|
|
|
|
generate :: PackageInfo -> Text
|
|
generate pkg = Lazy.Text.toStrict $ Text.Builder.toLazyText builder
|
|
where
|
|
digestToText = Text.pack . foldr hexAppender "" . ByteArray.unpack
|
|
hexAppender x acc
|
|
| x > 15 = showHex x acc
|
|
| otherwise = '0' : showHex x acc
|
|
builder = "PRGNAM=\"" <> Text.Builder.fromString (pkgname pkg) <> "\"\n"
|
|
<> "VERSION=\"" <> Text.Builder.fromText (version pkg) <> "\"\n"
|
|
<> "HOMEPAGE=\"" <> Text.Builder.fromText (homepage pkg) <> "\"\n"
|
|
<> generateMultiEntry "DOWNLOAD" (render <$> downloads pkg)
|
|
<> generateMultiEntry "MD5SUM" (digestToText <$> checksums pkg)
|
|
<> generateMultiEntry "DOWNLOAD_x86_64" (render <$> downloadX64 pkg)
|
|
<> generateMultiEntry "MD5SUM_x86_64" (digestToText <$> checksumX64 pkg)
|
|
<> "REQUIRES=\"" <> fromByteStringWords (requires pkg) <> "\"\n"
|
|
<> "MAINTAINER=\"" <> Text.Builder.fromText (maintainer pkg) <> "\"\n"
|
|
<> "EMAIL=\"" <> Text.Builder.fromText (email pkg) <> "\"\n"
|
|
fromByteStringWords = Text.Builder.fromText
|
|
. Text.unwords . fmap Text.decodeUtf8
|
|
|
|
generateMultiEntry :: Text -> [Text] -> Text.Builder
|
|
generateMultiEntry name entries = Text.Builder.fromText name
|
|
<> "=\""
|
|
<> Text.Builder.fromText (Text.intercalate separator entries)
|
|
<> "\"\n"
|
|
where
|
|
padLength = Text.length name + 2
|
|
separator = " \\\n" <> Text.replicate padLength " "
|