From 840290491f45157249ba97fb8f5e4cae9e04dc90 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 22 Sep 2023 07:33:02 +0200 Subject: Split the code into library and application --- app/SlackBuilder/Config.hs | 37 ------------ app/SlackBuilder/Package.hs | 115 -------------------------------------- app/SlackBuilder/Trans.hs | 29 ---------- lib/SlackBuilder/Config.hs | 37 ++++++++++++ lib/SlackBuilder/Package.hs | 115 ++++++++++++++++++++++++++++++++++++++ lib/SlackBuilder/Trans.hs | 29 ++++++++++ slackbuilder.cabal | 53 ++++++++++-------- tests/SlackBuilder/PackageSpec.hs | 14 ++++- 8 files changed, 222 insertions(+), 207 deletions(-) delete mode 100644 app/SlackBuilder/Config.hs delete mode 100644 app/SlackBuilder/Package.hs delete mode 100644 app/SlackBuilder/Trans.hs create mode 100644 lib/SlackBuilder/Config.hs create mode 100644 lib/SlackBuilder/Package.hs create mode 100644 lib/SlackBuilder/Trans.hs diff --git a/app/SlackBuilder/Config.hs b/app/SlackBuilder/Config.hs deleted file mode 100644 index c2a7f0b..0000000 --- a/app/SlackBuilder/Config.hs +++ /dev/null @@ -1,37 +0,0 @@ -module SlackBuilder.Config - ( Settings(..) - , MaintainerSettings(..) - , settingsCodec - ) where - -import Data.Text (Text) -import Toml ((.=)) -import qualified Toml - -data Settings = Settings - { ghToken :: !Text - , repository :: !FilePath - , 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 -settingsCodec = Settings - <$> Toml.text "gh_token" .= ghToken - <*> Toml.string "repository" .= repository - <*> 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/Package.hs b/app/SlackBuilder/Package.hs deleted file mode 100644 index a447609..0000000 --- a/app/SlackBuilder/Package.hs +++ /dev/null @@ -1,115 +0,0 @@ -module SlackBuilder.Package - ( DownloadPlaceholder(..) - , Download(..) - , DownloadTemplate(..) - , PackageInfo(..) - , Maintainer(..) - , Updater(..) - , infoTemplate - , renderDownloadWithVersion - ) 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 -import Control.Monad.Catch (MonadThrow) - --- | 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 - --- | Replaces placeholders in the URL template with the given version. -renderDownloadWithVersion :: MonadThrow m => DownloadTemplate -> Text -> m URI -renderDownloadWithVersion (DownloadTemplate components) version = - URI.mkURI $ foldr f "" components - where - f (StaticPlaceholder staticPlaceholder) accumulator = accumulator <> staticPlaceholder - f VersionPlaceholder accumulator = accumulator <> version - --- | Function used to get the latest version of a source. -data Updater = Updater (SlackBuilderT (Maybe Text)) DownloadTemplate - -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) diff --git a/app/SlackBuilder/Trans.hs b/app/SlackBuilder/Trans.hs deleted file mode 100644 index d678a19..0000000 --- a/app/SlackBuilder/Trans.hs +++ /dev/null @@ -1,29 +0,0 @@ -module SlackBuilder.Trans - ( SlackBuilderT(..) - ) where - -import Control.Monad.Trans.Reader (ReaderT(..)) -import SlackBuilder.Config -import Control.Monad.IO.Class (MonadIO(..)) - -newtype SlackBuilderT a = SlackBuilderT - { runSlackBuilderT :: ReaderT Settings IO a - } - -instance Functor SlackBuilderT - where - fmap f (SlackBuilderT slackBuilderT) = SlackBuilderT $ f <$> slackBuilderT - -instance Applicative SlackBuilderT - where - pure = SlackBuilderT . pure - (SlackBuilderT f) <*> (SlackBuilderT x) = SlackBuilderT $ f <*> x - -instance Monad SlackBuilderT - where - return = pure - (SlackBuilderT x) >>= f = SlackBuilderT $ x >>= runSlackBuilderT . f - -instance MonadIO SlackBuilderT - where - liftIO = SlackBuilderT . liftIO diff --git a/lib/SlackBuilder/Config.hs b/lib/SlackBuilder/Config.hs new file mode 100644 index 0000000..c2a7f0b --- /dev/null +++ b/lib/SlackBuilder/Config.hs @@ -0,0 +1,37 @@ +module SlackBuilder.Config + ( Settings(..) + , MaintainerSettings(..) + , settingsCodec + ) where + +import Data.Text (Text) +import Toml ((.=)) +import qualified Toml + +data Settings = Settings + { ghToken :: !Text + , repository :: !FilePath + , 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 +settingsCodec = Settings + <$> Toml.text "gh_token" .= ghToken + <*> Toml.string "repository" .= repository + <*> 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/lib/SlackBuilder/Package.hs b/lib/SlackBuilder/Package.hs new file mode 100644 index 0000000..a447609 --- /dev/null +++ b/lib/SlackBuilder/Package.hs @@ -0,0 +1,115 @@ +module SlackBuilder.Package + ( DownloadPlaceholder(..) + , Download(..) + , DownloadTemplate(..) + , PackageInfo(..) + , Maintainer(..) + , Updater(..) + , infoTemplate + , renderDownloadWithVersion + ) 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 +import Control.Monad.Catch (MonadThrow) + +-- | 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 + +-- | Replaces placeholders in the URL template with the given version. +renderDownloadWithVersion :: MonadThrow m => DownloadTemplate -> Text -> m URI +renderDownloadWithVersion (DownloadTemplate components) version = + URI.mkURI $ foldr f "" components + where + f (StaticPlaceholder staticPlaceholder) accumulator = accumulator <> staticPlaceholder + f VersionPlaceholder accumulator = accumulator <> version + +-- | Function used to get the latest version of a source. +data Updater = Updater (SlackBuilderT (Maybe Text)) DownloadTemplate + +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) diff --git a/lib/SlackBuilder/Trans.hs b/lib/SlackBuilder/Trans.hs new file mode 100644 index 0000000..d678a19 --- /dev/null +++ b/lib/SlackBuilder/Trans.hs @@ -0,0 +1,29 @@ +module SlackBuilder.Trans + ( SlackBuilderT(..) + ) where + +import Control.Monad.Trans.Reader (ReaderT(..)) +import SlackBuilder.Config +import Control.Monad.IO.Class (MonadIO(..)) + +newtype SlackBuilderT a = SlackBuilderT + { runSlackBuilderT :: ReaderT Settings IO a + } + +instance Functor SlackBuilderT + where + fmap f (SlackBuilderT slackBuilderT) = SlackBuilderT $ f <$> slackBuilderT + +instance Applicative SlackBuilderT + where + pure = SlackBuilderT . pure + (SlackBuilderT f) <*> (SlackBuilderT x) = SlackBuilderT $ f <*> x + +instance Monad SlackBuilderT + where + return = pure + (SlackBuilderT x) >>= f = SlackBuilderT $ x >>= runSlackBuilderT . f + +instance MonadIO SlackBuilderT + where + liftIO = SlackBuilderT . liftIO diff --git a/slackbuilder.cabal b/slackbuilder.cabal index a66a418..5f0c5e2 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -19,18 +19,11 @@ common dependencies ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: base ^>= 4.16.4.0, - -executable slackbuilder - import: dependencies - main-is: Main.hs - - other-modules: - SlackBuilder.CommandLine - SlackBuilder.Config - SlackBuilder.Download - SlackBuilder.Package - SlackBuilder.Trans - SlackBuilder.Updater + cryptonite >= 0.30, + filepath ^>= 1.4.2, + modern-uri ^>= 0.3.6, + text ^>= 2.0 + default-language: Haskell2010 default-extensions: DataKinds DuplicateRecordFields @@ -41,25 +34,38 @@ executable slackbuilder QuasiQuotes TemplateHaskell TypeApplications + +library slackbuilder-internal + import: dependencies + exposed-modules: + SlackBuilder.Config + SlackBuilder.Package + SlackBuilder.Trans + hs-source-dirs: lib + build-depends: + exceptions >= 0.10, + tomland ^>= 1.3.3, + transformers ^>= 0.5.6 + +executable slackbuilder + import: dependencies + main-is: Main.hs + + other-modules: + SlackBuilder.CommandLine + SlackBuilder.Download + SlackBuilder.Updater build-depends: aeson ^>= 2.2.0, bytestring ^>= 0.11.0, conduit ^>= 1.3.5, - cryptonite >= 0.30, - exceptions >= 0.10, - filepath ^>= 1.4.2, http-client ^>= 0.7, - modern-uri ^>= 0.3.6, optparse-applicative ^>= 0.18.1, process ^>= 1.6.17, req ^>= 3.13, - text ^>= 2.0, - tomland ^>= 1.3.3, - transformers ^>= 0.5.6, unordered-containers ^>= 0.2.19, vector ^>= 0.13.0 hs-source-dirs: app - default-language: Haskell2010 test-suite slackbuilder-test import: dependencies @@ -68,8 +74,7 @@ test-suite slackbuilder-test other-modules: SlackBuilder.PackageSpec - hs-source-dirs: - tests - default-language: Haskell2010 + hs-source-dirs: tests build-depends: - hspec >= 2.10.9 && < 2.12 + hspec >= 2.10.9 && < 2.12, + slackbuilder-internal diff --git a/tests/SlackBuilder/PackageSpec.hs b/tests/SlackBuilder/PackageSpec.hs index d8617a4..82d9a87 100644 --- a/tests/SlackBuilder/PackageSpec.hs +++ b/tests/SlackBuilder/PackageSpec.hs @@ -2,7 +2,17 @@ module SlackBuilder.PackageSpec ( spec ) where -import Test.Hspec (Spec) +import SlackBuilder.Package +import Test.Hspec (Spec, describe, it, shouldBe) +import Text.URI.QQ (uri) spec :: Spec -spec = pure () +spec = do + describe "renderDownloadWithVersion" $ + it "renders text as URL" $ + let given = DownloadTemplate + $ pure + $ StaticPlaceholder "https://example.com" + actual = renderDownloadWithVersion given "1.2" + expected = Just [uri|https://example.com|] + in actual `shouldBe` expected -- cgit v1.2.3