AppImage.hs

{-# LANGUAGE OverloadedRecordDot #-}

module HSInstall.AppImage
  ( dumpStockIcon, mkAppImage, prepAppImageFiles
  , stockIconFilename
  )
  where

import Control.Monad (unless)
import Data.Maybe (fromMaybe)
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
import System.Environment (setEnv)
import System.FilePath ((</>), (<.>), takeDirectory)

import HSInstall.DeploymentInfo (BinDir (..), PrefixDir (..),
  DeploymentInfo (binDir, prefixDir, tmplDir, version), TmplDir (v), prettyShow)
import HSInstall.Opts (ExeFile (..), Signing (SigningKeyId))
import HSInstall.Paths (getShareDir)
import HSInstall.System.Process (readProcessWithLogging)
import Paths_hsinstall (getDataDir)


data DesktopFileStatus = CreateNewDesktop | DesktopExists


desktopDir :: DeploymentInfo -> FilePath
desktopDir di = (tmplDir di).v </> "share" </> "applications"


iconDir :: DeploymentInfo -> FilePath
iconDir di = (tmplDir di).v </> "share" </> "icons" </> "hicolor" </> "scalable" </> "apps"


stockIconFilename :: FilePath
stockIconFilename = "unix-terminal" <.> "svg"


dumpStockIcon :: Maybe FilePath -> IO ()
dumpStockIcon mbDestPath = do
  shareDir <- getShareDir getDataDir
  let iconSourcePath = shareDir </> "resources" </> stockIconFilename
  let destPath = fromMaybe stockIconFilename mbDestPath
  copyFile iconSourcePath destPath


prepAppImageFiles :: ExeFile -> DeploymentInfo -> IO DesktopFileStatus
prepAppImageFiles (ExeFile exeFp) di = do
  -- Check and possibly create new icon
  let iconPath = iconDir di </> exeFp <.> "svg"
  iconExists <- doesFileExist iconPath
  unless iconExists $ do
    createDirectoryIfMissing True $ iconDir di
    dumpStockIcon $ Just iconPath

  -- Check desktop file, return status to caller
  let desktopPath = desktopDir di </> exeFp <.> "desktop"
  desktopFileExists <- doesFileExist desktopPath
  return $ if desktopFileExists then DesktopExists else CreateNewDesktop


newtype Arg = Arg String

mkAppImage :: Signing -> ExeFile -> DeploymentInfo -> DesktopFileStatus -> IO ()

mkAppImage signing exeFile di DesktopExists = do
  let desktopArg = Arg ("--desktop-file=" <>
        (desktopDir di </> exeFile.v <.> "desktop"))
  mkAppImage' signing exeFile di desktopArg

mkAppImage signing exeFile di CreateNewDesktop = do
  mkAppImage' signing exeFile di (Arg "--create-desktop-file")
  -- Now copy the freshly-created .desktop file into the project sources
  let desktopFile = exeFile.v <.> "desktop"
  createDirectoryIfMissing True $ desktopDir di
  copyFile
    (di.prefixDir.v </> "share" </> "applications" </> desktopFile)
    (desktopDir di </> desktopFile)


mkAppImage' :: Signing -> ExeFile -> DeploymentInfo -> Arg -> IO ()
mkAppImage' signing (ExeFile exeFp) di (Arg desktopArg) = do
  setEnv "LINUXDEPLOY_OUTPUT_VERSION" (prettyShow . version $ di)
  case signing of
    (SigningKeyId keyId) -> do
      setEnv "LDAI_SIGN" "1"
      setEnv "LDAI_SIGN_KEY" keyId
    _ -> pure ()
  readProcessWithLogging "Constructing AppImage"
    ( "linuxdeploy-x86_64.AppImage"
    , [ "--appdir=" <> takeDirectory di.prefixDir.v
      , "--executable=" <> (di.binDir.v </> exeFp)
      , desktopArg
      , "--icon-file=" <> (iconDir di </> exeFp <.> "svg")
      , "--output=appimage"
      ]
    )