Split the code into library and application
This commit is contained in:
37
lib/SlackBuilder/Config.hs
Normal file
37
lib/SlackBuilder/Config.hs
Normal 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
115
lib/SlackBuilder/Package.hs
Normal 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
29
lib/SlackBuilder/Trans.hs
Normal 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
|
Reference in New Issue
Block a user