diff options
| -rw-r--r-- | lib/SlackBuilder/Package.hs | 25 | ||||
| -rw-r--r-- | src/Main.hs | 90 |
2 files changed, 19 insertions, 96 deletions
diff --git a/lib/SlackBuilder/Package.hs b/lib/SlackBuilder/Package.hs index 5f8472e..5179c4c 100644 --- a/lib/SlackBuilder/Package.hs +++ b/lib/SlackBuilder/Package.hs @@ -2,15 +2,16 @@ 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/. -} --- | Contains data describing packages and how they are should be updated, +-- | Contains data describing packages, methods to update them and to request +-- information about them. module SlackBuilder.Package - ( DownloadPlaceholder(..) - , Download(..) + ( Download(..) , DownloadTemplate(..) , PackageDescription(..) , PackageUpdateData(..) , Updater(..) , renderDownloadWithVersion + , renderTextWithVersion ) where import Data.Text (Text) @@ -41,18 +42,6 @@ data Download = Download , md5sum :: Digest MD5 } 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 { unDownloadTemplate :: Text @@ -65,7 +54,11 @@ instance Show DownloadTemplate -- | Replaces placeholders in the URL template with the given version. renderDownloadWithVersion :: MonadThrow m => DownloadTemplate -> Text -> m URI renderDownloadWithVersion (DownloadTemplate template) version = - URI.mkURI $ Text.replace "{version}" version template + URI.mkURI $ renderTextWithVersion template version + +-- | Replaces placeholders in the text with the given version. +renderTextWithVersion :: Text -> Text -> Text +renderTextWithVersion template version = Text.replace "{version}" version template -- | Function used to get the latest version of a source. data Updater = Updater diff --git a/src/Main.hs b/src/Main.hs index 5e2b0ca..2f328f7 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -19,9 +19,8 @@ import qualified Toml import Data.Text (Text) import qualified Data.Text.IO as Text import Control.Monad.Trans.Reader (ReaderT(..), asks) -import SlackBuilder.Package (PackageDescription(..)) +import SlackBuilder.Package (PackageDescription(..), renderTextWithVersion) import qualified SlackBuilder.Package as Package -import Text.URI.QQ (uri) import Data.Foldable (find, traverse_) import GHC.Records (HasField(..)) import System.Console.ANSI @@ -31,15 +30,11 @@ import System.Console.ANSI , Color(..) , ConsoleLayer(..) ) -import Data.Maybe (fromJust, mapMaybe) +import Data.Maybe (mapMaybe) import qualified Text.URI as URI -findUpdatable :: Text -> [PackageSettings] -> DownloaderSettings -findUpdatable packageName = getField @"downloader" . fromJust - . find ((== packageName) . getField @"name" . getField @"downloader") - -githubAutoUpdatables :: [PackageSettings] -> [PackageDescription] -githubAutoUpdatables = mapMaybe go +autoUpdatable :: [PackageSettings] -> [PackageDescription] +autoUpdatable = mapMaybe go where go PackageSettings{ downloader = setting, downloaders } = do latest' <- packageUpdaterFromSettings setting @@ -68,83 +63,18 @@ packageUpdaterFromSettings DownloaderSettings{..} = do | Just packagistSettings <- packagist = let packagistArguments = uncurry PackageOwner packagistSettings in Just $ latestPackagist packagistArguments + | Just textSettings <- text = + let textArguments = uncurry TextArguments textSettings + in Just $ latestText textArguments version | otherwise = Nothing getVersionSettings | Just template' <- template = Just $ repackageWithTemplate repackage $ Package.DownloadTemplate template' - | Just CloneSettings{..} <- clone = - flip cloneFromGit tagTemplate <$> URI.mkURI remote + | Just CloneSettings{..} <- clone + = flip cloneFromGit (renderTextWithVersion tagTemplate version) + <$> URI.mkURI remote | otherwise = Nothing -autoUpdatable :: [PackageSettings] -> [PackageDescription] -autoUpdatable packageSettings = githubAutoUpdatables packageSettings ++ - [ PackageDescription - { latest = - let setting = findUpdatable "webex" packageSettings - textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting - template = Package.DownloadTemplate $ fromJust $ getField @"template" setting - in Package.Updater - { detectLatest = latestText textArguments (getField @"version" setting) - , getVersion = repackageWithTemplate (getField @"repackage" setting) template - , is64 = getField @"is64" setting - } - , name = "webex" - , downloaders = mempty - } - , PackageDescription - { latest = - let setting = findUpdatable "dmd" packageSettings - textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting - template = Package.DownloadTemplate $ fromJust $ getField @"template" setting - in Package.Updater - { detectLatest = latestText textArguments (getField @"version" setting) - , getVersion = repackageWithTemplate (getField @"repackage" setting) template - , is64 = getField @"is64" setting - } - , name = "dmd" - , downloaders = mempty - } - , PackageDescription - { latest = - let setting = findUpdatable "d-tools" packageSettings - textArguments = uncurry TextArguments $ fromJust $ getField @"text" setting - template = Package.DownloadTemplate $ fromJust $ getField @"template" setting - in Package.Updater - { detectLatest = latestText textArguments (getField @"version" setting) - , getVersion = repackageWithTemplate (getField @"repackage" setting) template - , is64 = getField @"is64" setting - } - , name = "d-tools" - , downloaders = - let dubArguments = PackageOwner{ owner = "dlang", name = "dub" } - dscannerArguments = PackageOwner{ owner = "dlang-community", name = "D-Scanner" } - dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" } - latestDub = Package.Updater - { detectLatest = latestGitHub dubArguments "(v)\\." - , getVersion = reuploadWithTemplate dubTemplate - , is64 = False - } - latestDscanner = Package.Updater - { detectLatest = latestGitHub dscannerArguments "(v)\\." - , getVersion = cloneFromGit dscannerURI "v" - , is64 = False - } - dcdURI = [uri|https://github.com/dlang-community/DCD.git|] - latestDcd = Package.Updater - { detectLatest = latestGitHub dcdArguments "(v)\\." - , getVersion = cloneFromGit dcdURI "v" - , is64 = False - } - dubTemplate = Package.DownloadTemplate "https://codeload.github.com/dlang/dub/tar.gz/v{version}" - dscannerURI = [uri|https://github.com/dlang-community/D-Scanner.git|] - in Map.fromList - [ ("DUB", latestDub) - , ("DSCANNER", latestDscanner) - , ("DCD", latestDcd) - ] - } - ] - up2Date :: Maybe Text -> SlackBuilderT () up2Date selectedPackage = do packages' <- SlackBuilderT $ asks (getField @"packages") |