slackbuilder/lib/SlackBuilder/Info.hs

{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

-- | Info file parsing and printing.
module SlackBuilder.Info
    ( PackageInfo(..)
    , generate
    , parseInfoFile
    , readInfoFile
    ) 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 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, parse, takeWhile1P)
import Text.Megaparsec.Byte (space, string, hexDigitChar)
import Text.URI
    ( URI(..)
    , parserBs
    , render
    )
import qualified Data.Word8 as Word8
import SlackBuilder.Trans
    ( SlackBuilderT(..)
    , SlackBuilderException(..)
    , relativeToRepository
    )
import System.FilePath ((</>), (<.>))
import Control.Monad.IO.Class (MonadIO(..))
import Conduit (MonadThrow(throwM))

type GenParser = Parsec Void ByteString

-- | Data used to generate an .info file.
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 = count 2 hexDigitChar
    >>= extractNumber . readHex . fmap (toEnum . fromIntegral)
  where
    extractNumber [(number, "")] = pure number
    extractNumber _ = fail "Unable to convert a 2-digit hexadecimal number"

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"

readInfoFile :: Text -> Text -> SlackBuilderT PackageInfo
readInfoFile category packageName' = do
    let packageName'' = Text.unpack packageName'

    infoPath <- relativeToRepository
        $ Text.unpack category </> packageName'' </> packageName'' <.> "info"
    infoContents <- liftIO $ ByteString.readFile infoPath

    either (throwM . MalformedInfoFile) pure
        $ parse parseInfoFile infoPath infoContents

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"
        <> downloadEntry
        <> 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
    downloadEntry
        | null $ downloads pkg
        , not $ null $ downloadX64 pkg = "DOWNLOAD=\"UNSUPPORTED\"\n"
        | otherwise = generateMultiEntry "DOWNLOAD" $ render <$> downloads pkg

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