slackbuilder/lib/SlackBuilder/Info.hs

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 " "