Combine info file structures

This commit is contained in:
2023-10-05 19:24:42 +02:00
parent 7b5598a02e
commit f3beee3e19
4 changed files with 38 additions and 107 deletions

View File

@ -15,28 +15,20 @@ import qualified Toml
import qualified Data.ByteString as ByteString
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Text.IO as Text.IO
import Control.Monad.Trans.Reader (ReaderT(..), asks)
import SlackBuilder.Download
import SlackBuilder.Package (Package(..))
import qualified SlackBuilder.Package as Package
import Text.URI (mkURI, URI)
import Text.URI (mkURI)
import Text.URI.QQ (uri)
import Data.Foldable (for_)
import qualified Text.URI as URI
import GHC.Records (HasField(..))
import System.FilePath ((</>), (<.>))
import SlackBuilder.Info
import Text.Megaparsec (parse, errorBundlePretty)
data Package = Package
{ latest :: Package.Updater
, category :: Text
, name :: Text
, homepage :: Maybe URI
, requires :: [Text]
, reupload :: Bool
}
autoUpdatable :: [Package]
autoUpdatable =
[ Package
@ -55,7 +47,7 @@ autoUpdatable =
in Package.Updater latest' template
, category = "development"
, name = "universal-ctags"
, homepage = Just [uri|https://ctags.io/|]
, homepage = [uri|https://ctags.io/|]
, requires = pure "%README%"
, reupload = True
}
@ -69,7 +61,7 @@ autoUpdatable =
in Package.Updater latest' template
, category = "development"
, name = "composer"
, homepage = Just [uri|https://getcomposer.org/|]
, homepage = [uri|https://getcomposer.org/|]
, requires = mempty
, reupload = False
}
@ -88,7 +80,7 @@ autoUpdatable =
in Package.Updater latest' template
, category = "network"
, name = "jitsi-meet-desktop"
, homepage = Just [uri|https://jitsi.org/|]
, homepage = [uri|https://jitsi.org/|]
, requires = mempty
, reupload = False
}
@ -110,7 +102,7 @@ autoUpdatable =
in Package.Updater latest' template
, category = "development"
, name = "php82"
, homepage = Just [uri|https://www.php.net/|]
, homepage = [uri|https://www.php.net/|]
, requires = ["postgresql"]
, reupload = False
}
@ -131,23 +123,12 @@ updatePackageIfRequired package@Package{..} version = do
infoContents <- liftIO $ ByteString.readFile $ repository' </> packagePath
case parse parseInfoFile packagePath infoContents of
Right _parsedInfoFile -> updatePackage package version
Right parsedInfoFile -> updatePackage package parsedInfoFile version
Left errorBundle -> liftIO $ putStr $ errorBundlePretty errorBundle
updatePackage :: Package -> Text -> SlackBuilderT ()
updatePackage Package{..} version = do
maintainer' <- SlackBuilderT $ asks $ getField @"maintainer"
updatePackage :: Package -> PackageInfo -> Text -> SlackBuilderT ()
updatePackage Package{..} info version = do
let packagePath = category <> "/" <> name
package' = Package.PackageInfo
{ version = version
, requires = requires
, path = Text.unpack packagePath
, homepage = maybe "" URI.render homepage
, maintainer = Package.Maintainer
{ name = getField @"name" maintainer'
, email = getField @"email" maintainer'
}
}
Package.Updater _ downloadTemplate = latest
repository' <- SlackBuilderT $ asks repository
@ -162,9 +143,15 @@ updatePackage Package{..} version = do
download' <- handleReupload uri' relativeTarball downloadFileName
let infoFilePath = repository' </> Text.unpack packagePath
</> (Text.unpack name <.> "info")
package' = info
{ version = version
, requires = Text.Encoding.encodeUtf8 <$> requires
, homepage = URI.render homepage
, downloads = [download']
, checksums = [checksum]
}
liftIO $ Text.IO.writeFile infoFilePath
$ Package.infoTemplate package' [Package.Download download' checksum False]
liftIO $ Text.IO.writeFile infoFilePath $ generate package'
updateSlackBuildVersion packagePath version
commit packagePath version
@ -176,7 +163,6 @@ updatePackage Package{..} version = do
>> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name <> "/" <> downloadFileName)
| otherwise = pure uri'
main :: IO ()
main = do
programCommand <- execParser slackBuilderParser