slackbuilder/lib/SlackBuilder/Info.hs

193 lines
7.0 KiB
Haskell
Raw Normal View History

2023-10-03 18:53:41 +02:00
module SlackBuilder.Info
( PackageInfo(..)
, generate
, parseInfoFile
, update
, updateDownloadVersion
) where
2023-10-04 22:36:19 +02:00
import Control.Applicative (Alternative(..))
2023-10-03 18:53:41 +02:00
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
)
2023-10-04 22:36:19 +02:00
import qualified Data.Word8 as Word8
2023-10-03 18:53:41 +02:00
type GenParser = Parsec Void ByteString
data PackageInfo = PackageInfo
{ pkgname :: String
, version :: Text
, homepage :: Text
, downloads :: [URI]
, checksums :: [Digest MD5]
2023-10-04 22:36:19 +02:00
, downloadX64 :: [URI]
, checksumX64 :: [Digest MD5]
, requires :: [ByteString]
, maintainer :: Text
, email :: Text
2023-10-03 18:53:41 +02:00
} deriving (Eq, Show)
variableEntry :: ByteString -> GenParser ByteString
variableEntry variable = string (Char8.append variable "=\"")
*> takeWhile1P Nothing (0x22 /=)
<* string "\"\n"
variableSeparator :: GenParser ()
variableSeparator = string " \\" *> space
2023-10-04 22:36:19 +02:00
packageDownloads :: ByteString -> GenParser [URI]
packageDownloads variableName = string (variableName <> "=\"")
2023-10-03 18:53:41 +02:00
*> 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
2023-10-04 22:36:19 +02:00
packageChecksums :: ByteString -> GenParser [ByteString]
packageChecksums variableName = string (variableName <> "=\"")
2023-10-03 18:53:41 +02:00
*> sepBy packageChecksum variableSeparator
<* string "\"\n"
2023-10-04 22:36:19 +02:00
packageRequires :: GenParser [ByteString]
packageRequires = string "REQUIRES=\""
2023-10-05 19:24:42 +02:00
*> sepBy (packageName <|> string "%README%") space
2023-10-04 22:36:19 +02:00
<* string "\"\n"
packageName :: GenParser ByteString
packageName = takeWhile1P Nothing isNameToken
where
isNameToken x = Word8.isAlphaNum x
|| x == Word8._hyphen
|| x == Word8._underscore
2023-10-03 18:53:41 +02:00
parseInfoFile :: GenParser PackageInfo
parseInfoFile = PackageInfo
2023-10-04 22:36:19 +02:00
<$> (Char8.unpack <$> packagePrgnam)
2023-10-03 18:53:41 +02:00
<*> (Text.decodeUtf8 <$> variableEntry "VERSION")
<*> (Text.decodeUtf8 <$> variableEntry "HOMEPAGE")
2023-10-04 22:36:19 +02:00
<*> 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")
2023-10-03 18:53:41 +02:00
<* eof
2023-10-04 22:36:19 +02:00
where
packagePrgnam = (string "PKGNAM" <|> string "PRGNAM")
>> string "=\""
*> packageName
<* "\"\n"
2023-10-03 18:53:41 +02:00
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
2023-10-05 19:24:42 +02:00
builder = "PRGNAM=\"" <> Text.Builder.fromString (pkgname pkg) <> "\"\n"
2023-10-03 18:53:41 +02:00
<> "VERSION=\"" <> Text.Builder.fromText (version pkg) <> "\"\n"
<> "HOMEPAGE=\"" <> Text.Builder.fromText (homepage pkg) <> "\"\n"
<> generateMultiEntry "DOWNLOAD" (render <$> downloads pkg)
<> generateMultiEntry "MD5SUM" (digestToText <$> checksums pkg)
2023-10-08 12:28:46 +02:00
<> generateMultiEntry "DOWNLOAD_x86_64" (render <$> downloadX64 pkg)
<> generateMultiEntry "MD5SUM_x86_64" (digestToText <$> checksumX64 pkg)
2023-10-05 19:24:42 +02:00
<> "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
2023-10-03 18:53:41 +02:00
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 " "