Accept up2date package parameter
This commit is contained in:
parent
e9504fb8e5
commit
6a063b2cc4
@ -2,8 +2,6 @@ module SlackBuilder.Info
|
|||||||
( PackageInfo(..)
|
( PackageInfo(..)
|
||||||
, generate
|
, generate
|
||||||
, parseInfoFile
|
, parseInfoFile
|
||||||
, update
|
|
||||||
, updateDownloadVersion
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative (Alternative(..))
|
import Control.Applicative (Alternative(..))
|
||||||
@ -12,7 +10,6 @@ import qualified Data.ByteArray as ByteArray
|
|||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Data.ByteString as ByteString
|
import qualified Data.ByteString as ByteString
|
||||||
import qualified Data.ByteString.Char8 as Char8
|
import qualified Data.ByteString.Char8 as Char8
|
||||||
import qualified Data.List.NonEmpty as NonEmpty
|
|
||||||
import Data.Maybe (mapMaybe)
|
import Data.Maybe (mapMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
@ -27,17 +24,15 @@ import Numeric (readHex, showHex)
|
|||||||
import Text.Megaparsec (Parsec, count, eof, takeWhile1P)
|
import Text.Megaparsec (Parsec, count, eof, takeWhile1P)
|
||||||
import Text.Megaparsec.Byte (space, string, hexDigitChar)
|
import Text.Megaparsec.Byte (space, string, hexDigitChar)
|
||||||
import Text.URI
|
import Text.URI
|
||||||
( Authority(..)
|
( URI(..)
|
||||||
, URI(..)
|
|
||||||
, mkPathPiece
|
|
||||||
, parserBs
|
, parserBs
|
||||||
, render
|
, render
|
||||||
, unRText
|
|
||||||
)
|
)
|
||||||
import qualified Data.Word8 as Word8
|
import qualified Data.Word8 as Word8
|
||||||
|
|
||||||
type GenParser = Parsec Void ByteString
|
type GenParser = Parsec Void ByteString
|
||||||
|
|
||||||
|
-- | Data used to generate an .info file.
|
||||||
data PackageInfo = PackageInfo
|
data PackageInfo = PackageInfo
|
||||||
{ pkgname :: String
|
{ pkgname :: String
|
||||||
, version :: Text
|
, version :: Text
|
||||||
@ -108,60 +103,6 @@ parseInfoFile = PackageInfo
|
|||||||
*> packageName
|
*> packageName
|
||||||
<* "\"\n"
|
<* "\"\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 :: PackageInfo -> Text
|
||||||
generate pkg = Lazy.Text.toStrict $ Text.Builder.toLazyText builder
|
generate pkg = Lazy.Text.toStrict $ Text.Builder.toLazyText builder
|
||||||
where
|
where
|
||||||
|
@ -3,7 +3,6 @@ module SlackBuilder.Package
|
|||||||
, Download(..)
|
, Download(..)
|
||||||
, DownloadTemplate(..)
|
, DownloadTemplate(..)
|
||||||
, Package(..)
|
, Package(..)
|
||||||
, PackageInfo(..)
|
|
||||||
, Maintainer(..)
|
, Maintainer(..)
|
||||||
, Updater(..)
|
, Updater(..)
|
||||||
, renderDownloadWithVersion
|
, renderDownloadWithVersion
|
||||||
@ -34,15 +33,6 @@ data Download = Download
|
|||||||
, is64 :: Bool
|
, is64 :: Bool
|
||||||
} deriving (Eq, Show)
|
} 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.
|
-- | Package maintainer information.
|
||||||
data Maintainer = Maintainer
|
data Maintainer = Maintainer
|
||||||
{ name :: Text
|
{ name :: Text
|
||||||
|
@ -1,11 +1,19 @@
|
|||||||
module SlackBuilder.Trans
|
module SlackBuilder.Trans
|
||||||
( SlackBuilderT(..)
|
( SlackBuilderException(..)
|
||||||
|
, SlackBuilderT(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.Reader (ReaderT(..))
|
import Control.Monad.Trans.Reader (ReaderT(..))
|
||||||
|
import Data.Text (Text)
|
||||||
import SlackBuilder.Config
|
import SlackBuilder.Config
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
|
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
|
||||||
|
import Control.Exception (Exception(..))
|
||||||
|
|
||||||
|
newtype SlackBuilderException = UpdaterNotFound Text
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Exception SlackBuilderException
|
||||||
|
|
||||||
newtype SlackBuilderT a = SlackBuilderT
|
newtype SlackBuilderT a = SlackBuilderT
|
||||||
{ runSlackBuilderT :: ReaderT Settings IO a
|
{ runSlackBuilderT :: ReaderT Settings IO a
|
||||||
|
@ -22,6 +22,7 @@ common dependencies
|
|||||||
containers ^>= 0.6,
|
containers ^>= 0.6,
|
||||||
cryptonite >= 0.30,
|
cryptonite >= 0.30,
|
||||||
directory ^>= 1.3.8,
|
directory ^>= 1.3.8,
|
||||||
|
exceptions >= 0.10,
|
||||||
filepath ^>= 1.4.2,
|
filepath ^>= 1.4.2,
|
||||||
megaparsec ^>= 9.5,
|
megaparsec ^>= 9.5,
|
||||||
modern-uri ^>= 0.3.6,
|
modern-uri ^>= 0.3.6,
|
||||||
@ -58,7 +59,6 @@ library
|
|||||||
hs-source-dirs: lib
|
hs-source-dirs: lib
|
||||||
build-depends:
|
build-depends:
|
||||||
conduit ^>= 1.3.5,
|
conduit ^>= 1.3.5,
|
||||||
exceptions >= 0.10,
|
|
||||||
http-client ^>= 0.7
|
http-client ^>= 0.7
|
||||||
|
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
14
src/Main.hs
14
src/Main.hs
@ -6,6 +6,7 @@ import Data.Char (isNumber)
|
|||||||
import Control.Applicative (Applicative(liftA2))
|
import Control.Applicative (Applicative(liftA2))
|
||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
import qualified Data.List.NonEmpty as NonEmpty
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
|
import Control.Monad.Catch (MonadThrow(..))
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@ -250,8 +251,13 @@ autoUpdatable =
|
|||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
|
||||||
up2Date :: SlackBuilderT ()
|
up2Date :: Maybe Text -> SlackBuilderT ()
|
||||||
up2Date = for_ autoUpdatable go
|
up2Date = \case
|
||||||
|
Nothing -> for_ autoUpdatable go
|
||||||
|
Just packageName
|
||||||
|
| Just foundPackage <- find ((packageName ==) . getField @"name") autoUpdatable ->
|
||||||
|
go foundPackage
|
||||||
|
| otherwise -> throwM $ UpdaterNotFound packageName
|
||||||
where
|
where
|
||||||
go package = getAndLogLatest package
|
go package = getAndLogLatest package
|
||||||
>>= mapM_ (updatePackageIfRequired package)
|
>>= mapM_ (updatePackageIfRequired package)
|
||||||
@ -427,10 +433,10 @@ main = do
|
|||||||
maybe (pure ()) Text.IO.putStrLn latestVersion
|
maybe (pure ()) Text.IO.putStrLn latestVersion
|
||||||
where
|
where
|
||||||
executeCommand = \case
|
executeCommand = \case
|
||||||
CategoryCommand _packageName -> do
|
CategoryCommand -> do
|
||||||
repository' <- SlackBuilderT $ asks repository
|
repository' <- SlackBuilderT $ asks repository
|
||||||
categories <- liftIO $ findCategory repository'
|
categories <- liftIO $ findCategory repository'
|
||||||
liftIO $ print $ splitFileName . makeRelative repository' <$> categories
|
liftIO $ print $ splitFileName . makeRelative repository' <$> categories
|
||||||
pure Nothing
|
pure Nothing
|
||||||
CheckCommand -> check >> pure Nothing
|
CheckCommand -> check >> pure Nothing
|
||||||
Up2DateCommand -> up2Date >> pure Nothing
|
Up2DateCommand packageName -> up2Date packageName >> pure Nothing
|
||||||
|
@ -16,13 +16,14 @@ import Options.Applicative
|
|||||||
, info
|
, info
|
||||||
, fullDesc
|
, fullDesc
|
||||||
, subparser
|
, subparser
|
||||||
, command,
|
, command
|
||||||
|
, optional
|
||||||
)
|
)
|
||||||
|
|
||||||
data SlackBuilderCommand
|
data SlackBuilderCommand
|
||||||
= CategoryCommand Text
|
= CategoryCommand
|
||||||
| CheckCommand
|
| CheckCommand
|
||||||
| Up2DateCommand
|
| Up2DateCommand (Maybe Text)
|
||||||
|
|
||||||
data PackagistArguments = PackagistArguments
|
data PackagistArguments = PackagistArguments
|
||||||
{ vendor :: Text
|
{ vendor :: Text
|
||||||
@ -49,7 +50,7 @@ slackBuilderCommand = subparser
|
|||||||
<> command "check" (info checkCommand mempty)
|
<> command "check" (info checkCommand mempty)
|
||||||
<> command "up2date" (info up2DateCommand mempty)
|
<> command "up2date" (info up2DateCommand mempty)
|
||||||
where
|
where
|
||||||
categoryCommand = CategoryCommand
|
categoryCommand = pure CategoryCommand
|
||||||
<$> argument str (metavar "PKGNAM")
|
|
||||||
checkCommand = pure CheckCommand
|
checkCommand = pure CheckCommand
|
||||||
up2DateCommand = pure Up2DateCommand
|
up2DateCommand = Up2DateCommand
|
||||||
|
<$> optional (argument str (metavar "PKGNAM"))
|
||||||
|
@ -100,55 +100,3 @@ spec = do
|
|||||||
given = PackageInfo
|
given = PackageInfo
|
||||||
"pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
"pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
||||||
in generate given `shouldBe` Text.decodeUtf8 infoDownload1
|
in generate given `shouldBe` Text.decodeUtf8 infoDownload1
|
||||||
|
|
||||||
describe "updateDownloadVersion" $ do
|
|
||||||
it "replaces the version" $
|
|
||||||
let downloads' = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/download-1.2.3.tar.gz"
|
|
||||||
testPackage = PackageInfo
|
|
||||||
"pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
expected = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/download-2.3.4.tar.gz"
|
|
||||||
actual = updateDownloadVersion testPackage "2.3.4" Nothing
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "updates the major version" $
|
|
||||||
let downloads' = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/1.2/download.tar.gz"
|
|
||||||
testPackage = PackageInfo
|
|
||||||
"pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
expected = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/2.3/download.tar.gz"
|
|
||||||
actual = updateDownloadVersion testPackage "2.3.4" Nothing
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "updates gnome version" $
|
|
||||||
let downloads' = maybeToList
|
|
||||||
$ mkURI "https://download.gnome.org/core/3.36/3.36.0/sources/gnome-calendar-3.36.0.tar.xz"
|
|
||||||
testPackage = PackageInfo "gnome-calendar" "3.36.0" "https://wiki.gnome.org/Core/Calendar"
|
|
||||||
downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
expected = maybeToList
|
|
||||||
$ mkURI "https://download.gnome.org/core/3.36/3.36.4/sources/gnome-calendar-3.36.2.tar.xz"
|
|
||||||
actual = updateDownloadVersion testPackage "3.36.2" $ Just "3.36.4"
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "updates versions without a patch number" $
|
|
||||||
let downloads' = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/gnome-contacts-3.36.tar.xz"
|
|
||||||
testPackage = PackageInfo
|
|
||||||
"gnome-contacts" "3.36" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
expected = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/gnome-contacts-3.36.2.tar.xz"
|
|
||||||
actual = updateDownloadVersion testPackage "3.36.2" Nothing
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
describe "update" $
|
|
||||||
it "replaces the version" $
|
|
||||||
let downloads' = maybeToList
|
|
||||||
$ mkURI "https://dlackware.com/1.2/download.tar.gz"
|
|
||||||
testPackage = PackageInfo
|
|
||||||
"pkgnam" "1.2.3" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
expected = PackageInfo
|
|
||||||
"pkgnam" "2.3.4" "homepage" downloads' checksumSample [] [] [] "Z" "test@example.com"
|
|
||||||
given = update testPackage "2.3.4" downloads' checksumSample
|
|
||||||
in given `shouldBe` expected
|
|
||||||
|
Loading…
Reference in New Issue
Block a user