Reimplement the info file printer

4 files changed, 141 insertions, 1 deletions

diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs
index 1b0d7ed..23bf840 100644
--- a/app/SlackBuilder/CommandLine.hs
+++ b/app/SlackBuilder/CommandLine.hs
@@ -29,6 +29,7 @@ data SlackBuilderCommand
     | ArchiveCommand Text Text String Text
     | DownloadCommand Text String
     | CloneCommand Text Text Text
+    | DownloadAndDeployCommand Text Text
     deriving (Eq, Show)
 
 data PackagistArguments = PackagistArguments
@@ -73,6 +74,7 @@ slackBuilderCommand = subparser
     <> command "archive" (info archiveCommand mempty)
     <> command "download" (info downloadCommand mempty)
     <> command "clone" (info cloneCommand mempty)
+    <> command "deploy" (info deployCommand mempty)
   where
     slackBuildCommand = SlackBuildCommand
         <$> argument str (metavar "PATH")
@@ -93,3 +95,6 @@ slackBuilderCommand = subparser
         <$> argument str (metavar "REPO")
         <*> argument str (metavar "TARBALL")
         <*> argument str (metavar "TAG_PREFIX")
+    deployCommand = DownloadAndDeployCommand
+        <$> argument str (metavar "URI")
+        <*> argument str (metavar "TARBALL")
diff --git a/app/SlackBuilder/Config.hs b/app/SlackBuilder/Config.hs
index d7652e8..c2a7f0b 100644
--- a/app/SlackBuilder/Config.hs
+++ b/app/SlackBuilder/Config.hs
@@ -1,5 +1,6 @@
 module SlackBuilder.Config
     ( Settings(..)
+    , MaintainerSettings(..)
     , settingsCodec
     ) where
 
@@ -13,6 +14,12 @@ data Settings = Settings
     , 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
@@ -22,3 +29,9 @@ settingsCodec = Settings
     <*> 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/Download.hs b/app/SlackBuilder/Download.hs
index c6516d4..2201c25 100644
--- a/app/SlackBuilder/Download.hs
+++ b/app/SlackBuilder/Download.hs
@@ -3,6 +3,7 @@ module SlackBuilder.Download
     , cloneAndArchive
     , commit
     , download
+    , downloadAndDeploy
     , hostedSources
     , remoteFileExists
     , updateSlackBuildVersion
@@ -173,10 +174,11 @@ download uri target = traverse (runReq defaultHttpConfig . go . fst)
 
 clone :: Text -> Text -> Text -> SlackBuilderT (Maybe (Digest MD5))
 clone repo tarball tagPrefix = do
+    repository' <- SlackBuilderT $ asks repository
     let tarballPath = Text.unpack tarball
         nameVersion = Text.pack $ takeBaseName tarballPath
         remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
-        localPath = "slackbuilds" </> tarballPath
+        localPath = repository' </> tarballPath
     remoteFileExists' <- remoteFileExists remotePath
 
     if remoteFileExists'
@@ -187,3 +189,19 @@ clone repo tarball tagPrefix = do
          in cloneAndArchive repo nameVersion tarballPath tagPrefix
             >> uploadCommand tarball remotePath
             >> liftIO (runConduitRes go) <&> Just
+
+downloadAndDeploy :: Text -> Text -> SlackBuilderT (Maybe (Digest MD5))
+downloadAndDeploy uri tarball = do
+    repository' <- SlackBuilderT $ asks repository
+    let tarballPath = Text.unpack tarball
+        remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
+        localPath = repository' </> tarballPath
+    remoteFileExists' <- remoteFileExists remotePath
+
+    if remoteFileExists'
+    then
+        hostedSources remotePath >>= flip download localPath
+    else do
+        checksum <- liftIO (mkURI uri) >>= flip download localPath
+        uploadCommand tarball remotePath
+        pure checksum
diff --git a/app/SlackBuilder/Package.hs b/app/SlackBuilder/Package.hs
new file mode 100644
index 0000000..cc07cc5
--- /dev/null
+++ b/app/SlackBuilder/Package.hs
@@ -0,0 +1,104 @@
+module SlackBuilder.Package
+    ( DownloadPlaceholder(..)
+    , Download(..)
+    , PackageInfo(..)
+    , Maintainer(..)
+    , Updater(..)
+    , infoTemplate
+    ) 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
+
+-- | 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
+
+-- | Function used to get the latest version of a source.
+newtype Updater = Updater (SlackBuilderT (Maybe Text))
+
+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)