diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Main.hs | 2 | ||||
| -rw-r--r-- | app/SlackBuilder/CommandLine.hs | 5 | ||||
| -rw-r--r-- | app/SlackBuilder/Config.hs | 13 | ||||
| -rw-r--r-- | app/SlackBuilder/Download.hs | 20 | ||||
| -rw-r--r-- | app/SlackBuilder/Package.hs | 104 |
5 files changed, 143 insertions, 1 deletions
diff --git a/app/Main.hs b/app/Main.hs index 654dcf7..76c985f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -45,6 +45,8 @@ main = do | otherwise -> pure Nothing CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show) <$> clone repo tarball tagPrefix + DownloadAndDeployCommand uri tarball -> fmap (Text.pack . show) + <$> downloadAndDeploy uri tarball chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction _ = stripPrefix "v" diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs index 1b0d7ed..23bf840 100644 --- a/app/SlackBuilder/CommandLine.hs +++ b/app/SlackBuilder/CommandLine.hs @@ -29,6 +29,7 @@ data SlackBuilderCommand | ArchiveCommand Text Text String Text | DownloadCommand Text String | CloneCommand Text Text Text + | DownloadAndDeployCommand Text Text deriving (Eq, Show) data PackagistArguments = PackagistArguments @@ -73,6 +74,7 @@ slackBuilderCommand = subparser <> command "archive" (info archiveCommand mempty) <> command "download" (info downloadCommand mempty) <> command "clone" (info cloneCommand mempty) + <> command "deploy" (info deployCommand mempty) where slackBuildCommand = SlackBuildCommand <$> argument str (metavar "PATH") @@ -93,3 +95,6 @@ slackBuilderCommand = subparser <$> argument str (metavar "REPO") <*> argument str (metavar "TARBALL") <*> argument str (metavar "TAG_PREFIX") + deployCommand = DownloadAndDeployCommand + <$> argument str (metavar "URI") + <*> argument str (metavar "TARBALL") diff --git a/app/SlackBuilder/Config.hs b/app/SlackBuilder/Config.hs index d7652e8..c2a7f0b 100644 --- a/app/SlackBuilder/Config.hs +++ b/app/SlackBuilder/Config.hs @@ -1,5 +1,6 @@ module SlackBuilder.Config ( Settings(..) + , MaintainerSettings(..) , settingsCodec ) where @@ -13,6 +14,12 @@ data Settings = Settings , branch :: Text , downloadURL :: Text , remotePath :: Text + , maintainer :: MaintainerSettings + } deriving (Eq, Show) + +data MaintainerSettings = MaintainerSettings + { name :: !Text + , email :: !Text } deriving (Eq, Show) settingsCodec :: Toml.TomlCodec Settings @@ -22,3 +29,9 @@ settingsCodec = Settings <*> Toml.text "branch" .= branch <*> Toml.text "download_url" .= downloadURL <*> Toml.text "remote_path" .= remotePath + <*> Toml.table maintainerSettingsCodec "maintainer" .= maintainer + +maintainerSettingsCodec :: Toml.TomlCodec MaintainerSettings +maintainerSettingsCodec = MaintainerSettings + <$> Toml.text "name" .= name + <*> Toml.text "email" .= email diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs index c6516d4..2201c25 100644 --- a/app/SlackBuilder/Download.hs +++ b/app/SlackBuilder/Download.hs @@ -3,6 +3,7 @@ module SlackBuilder.Download , cloneAndArchive , commit , download + , downloadAndDeploy , hostedSources , remoteFileExists , updateSlackBuildVersion @@ -173,10 +174,11 @@ download uri target = traverse (runReq defaultHttpConfig . go . fst) clone :: Text -> Text -> Text -> SlackBuilderT (Maybe (Digest MD5)) clone repo tarball tagPrefix = do + repository' <- SlackBuilderT $ asks repository let tarballPath = Text.unpack tarball nameVersion = Text.pack $ takeBaseName tarballPath remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath - localPath = "slackbuilds" </> tarballPath + localPath = repository' </> tarballPath remoteFileExists' <- remoteFileExists remotePath if remoteFileExists' @@ -187,3 +189,19 @@ clone repo tarball tagPrefix = do in cloneAndArchive repo nameVersion tarballPath tagPrefix >> uploadCommand tarball remotePath >> liftIO (runConduitRes go) <&> Just + +downloadAndDeploy :: Text -> Text -> SlackBuilderT (Maybe (Digest MD5)) +downloadAndDeploy uri tarball = do + repository' <- SlackBuilderT $ asks repository + let tarballPath = Text.unpack tarball + remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath + localPath = repository' </> tarballPath + remoteFileExists' <- remoteFileExists remotePath + + if remoteFileExists' + then + hostedSources remotePath >>= flip download localPath + else do + checksum <- liftIO (mkURI uri) >>= flip download localPath + uploadCommand tarball remotePath + pure checksum diff --git a/app/SlackBuilder/Package.hs b/app/SlackBuilder/Package.hs new file mode 100644 index 0000000..cc07cc5 --- /dev/null +++ b/app/SlackBuilder/Package.hs @@ -0,0 +1,104 @@ +module SlackBuilder.Package + ( DownloadPlaceholder(..) + , Download(..) + , PackageInfo(..) + , Maintainer(..) + , Updater(..) + , infoTemplate + ) where + +import Data.List.NonEmpty (NonEmpty) +import Data.Text (Text) +import qualified Data.Text as Text +import Text.URI (URI(..)) +import qualified Text.URI as URI +import Crypto.Hash (Digest, MD5) +import GHC.Records (HasField(..)) +import System.FilePath (takeBaseName) +import Data.List (partition) +import SlackBuilder.Trans + +-- | Download URI with the MD5 checksum of the target. +data Download = Download + { download :: URI + , md5sum :: Digest MD5 + , is64 :: Bool + } deriving (Eq, Show) + +-- | Data used to generate an .info file. +data PackageInfo = PackageInfo + { path :: FilePath + , version :: Text + , homepage :: Text + , requires :: [Text] + , maintainer :: Maintainer + } deriving (Eq, Show) + +-- | Package maintainer information. +data Maintainer = Maintainer + { name :: Text + , email :: Text + } deriving (Eq, Show) + +-- | Appears in the download URI template and specifies which part of the URI +-- should be replaced with the package version. +data DownloadPlaceholder + = StaticPlaceholder Text + | VersionPlaceholder + deriving Eq + +instance Show DownloadPlaceholder + where + show (StaticPlaceholder staticPlaceholder) = Text.unpack staticPlaceholder + show VersionPlaceholder = "{version}" + +-- | List of URI components, including version placeholders. +newtype DownloadTemplate = DownloadTemplate (NonEmpty DownloadPlaceholder) + deriving Eq + +instance Show DownloadTemplate + where + show (DownloadTemplate components) = concatMap show components + +-- | Function used to get the latest version of a source. +newtype Updater = Updater (SlackBuilderT (Maybe Text)) + +packageName :: PackageInfo -> Text +packageName PackageInfo{ path } = Text.pack $ takeBaseName path + +infoTemplate :: PackageInfo -> [Download] -> Text +infoTemplate package downloads = + let (downloads64, downloads32) = partition (getField @"is64") downloads + (download32, md5sum32, download64, md5sum64) = downloadEntries downloads64 downloads32 + + in Text.unlines + [ "PRGNAM=\"" <> packageName package <> "\"" + , "VERSION=\"" <> getField @"version" package <> "\"" + , "HOMEPAGE=\"" <> getField @"homepage" package <> "\"" + , "DOWNLOAD=\"" <> download32 <> "\"" + , "MD5SUM=\"" <> md5sum32 <> "\"" + , "DOWNLOAD_x86_64=\"" <> download64 <> "\"" + , "MD5SUM_x86_64=\"" <> md5sum64 <> "\"" + , "REQUIRES=\"" <> Text.unwords (getField @"requires" package) <> "\"" + , "MAINTAINER=\"" <> getField @"name" (getField @"maintainer" package) <> "\"" + , "EMAIL=\"" <> getField @"email" (getField @"maintainer" package) <> "\"" + ] + +downloadEntries :: [Download] -> [Download] -> (Text, Text, Text, Text) +downloadEntries downloads64 downloads32 = + let download32 = + if null downloads32 && not (null downloads64) + then + "UNSUPPORTED" + else + Text.intercalate " \\\n " + $ URI.render . getField @"download" <$> downloads32 + + md5sum32 = Text.intercalate " \\\n " + $ Text.pack . show . getField @"md5sum" <$> downloads32 + download64 = Text.intercalate " \\\n " + $ URI.render . getField @"download" <$> downloads64 + md5sum64 = Text.intercalate " \\\n " + $ Text.pack . show . getField @"md5sum" <$> downloads64 + + in (download32, md5sum32, download64, md5sum64) |