Split the code into library and application

This commit is contained in:
2023-09-22 07:33:02 +02:00
parent a7114618c1
commit 840290491f
5 changed files with 41 additions and 26 deletions

View File

@ -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

115
lib/SlackBuilder/Package.hs Normal file
View File

@ -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)

29
lib/SlackBuilder/Trans.hs Normal file
View File

@ -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