{-|
Module:    Distribution.AppImage
Copyright: 2020 Gabriele Sales

This module provides a custom build hook for automating the creation of AppImage
bundles.

Internally, it calls the [appimagetool](https://github.com/AppImage/AppImageKit)
and [linuxdeploy](https://github.com/linuxdeploy/linuxdeploy) utilities which
must be already present on the system.
-}

{-# LANGUAGE RecordWildCards #-}

module Distribution.AppImage
  ( AppImage(..)
  , AppDirCustomize
  , appImageBuildHook
  )
where

import           Control.Monad
import           Data.Maybe
import           Data.String
import           Distribution.PackageDescription
import           Distribution.Simple
import           Distribution.Simple.LocalBuildInfo
import           Distribution.Simple.Program
import           Distribution.Simple.Program.Types
import           Distribution.Simple.Setup
import           Distribution.Simple.Utils
import           Distribution.System
import           Distribution.Verbosity
import           System.FilePath


data AppImage = AppImage {
  -- | Application name. The AppImage bundle will be produced in
  -- @dist\/build\//appName/.AppImage@ and will contain the executable
  -- /appName/.
  AppImage -> String
appName         :: String,
  -- | Path to desktop file.
  AppImage -> String
appDesktop      :: FilePath,
  -- | Application icons.
  AppImage -> [String]
appIcons        :: [FilePath],
  -- | Other resources to bundle. Stored in the @\usr\/share\//appName/@
  -- directory inside the image. The first 'FilePath' is on the local system.
  -- The @Maybe 'FilePath'@ is the desired file path relative to
  -- @\usr\/share\//appName/@, or the directoryless filename in the case of
  -- 'Nothing'.
  AppImage -> [(String, Maybe String)]
appResources    :: [(FilePath, Maybe FilePath)],
  -- | Hook to customize the generated @AppDir@ before final packaging.
  AppImage -> Maybe AppDirCustomize
appDirCustomize :: Maybe AppDirCustomize
  }

type AppDirCustomize
  = FilePath   -- ^ AppDir path.
 -> Args       -- ^ Other parameters as defined in 'Distribution.Simple.postBuild'.
 -> BuildFlags
 -> PackageDescription
 -> LocalBuildInfo
 -> IO ()


-- | Hook for building AppImage bundles. Does nothing if the OS is not Linux.
--
-- Use this function as a @postBuild@ hook.
appImageBuildHook
  :: [AppImage] -- ^ Applications to build.
  -> Args       -- ^ Other parameters as defined in 'Distribution.Simple.postBuild'.
  -> BuildFlags
  -> PackageDescription
  -> LocalBuildInfo
  -> IO ()
appImageBuildHook :: [AppImage]
-> [String]
-> BuildFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
appImageBuildHook [AppImage]
apps [String]
args BuildFlags
flags PackageDescription
pkg LocalBuildInfo
buildInfo =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OS
buildOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Linux) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    (AppImage -> IO ()) -> [AppImage] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([String]
-> BuildFlags
-> PackageDescription
-> LocalBuildInfo
-> AppImage
-> IO ()
makeBundle [String]
args BuildFlags
flags PackageDescription
pkg LocalBuildInfo
buildInfo) [AppImage]
apps

makeBundle :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> AppImage -> IO ()
makeBundle :: [String]
-> BuildFlags
-> PackageDescription
-> LocalBuildInfo
-> AppImage
-> IO ()
makeBundle [String]
args BuildFlags
flags PackageDescription
pkg LocalBuildInfo
buildInfo app :: AppImage
app@AppImage{String
[String]
[(String, Maybe String)]
Maybe AppDirCustomize
appName :: AppImage -> String
appDesktop :: AppImage -> String
appIcons :: AppImage -> [String]
appResources :: AppImage -> [(String, Maybe String)]
appDirCustomize :: AppImage -> Maybe AppDirCustomize
appName :: String
appDesktop :: String
appIcons :: [String]
appResources :: [(String, Maybe String)]
appDirCustomize :: Maybe AppDirCustomize
..} = do
  let bdir :: String
bdir = LocalBuildInfo -> String
buildDir LocalBuildInfo
buildInfo
      verb :: Verbosity
verb = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PackageDescription -> String -> Bool
hasExecutable PackageDescription
pkg String
appName) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verb (String
"No executable defined for the AppImage bundle: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appName)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
appIcons) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verb (String
"No icon defined for the AppImage bundle: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appName)
  Verbosity -> String -> String -> (String -> IO ()) -> IO ()
forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
withTempDirectory Verbosity
verb String
bdir String
"appimage." ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
appDir -> do
    String -> AppImage -> String -> Verbosity -> IO ()
deployExe (String
bdir String -> String -> String
</> String
appName String -> String -> String
</> String
appName) AppImage
app String
appDir Verbosity
verb
    [(String, Maybe String)] -> String -> Verbosity -> IO ()
bundleFiles [(String, Maybe String)]
appResources (String
appDir String -> String -> String
</> String
"usr" String -> String -> String
</> String
"share" String -> String -> String
</> String
appName) Verbosity
verb
    AppDirCustomize -> Maybe AppDirCustomize -> AppDirCustomize
forall a. a -> Maybe a -> a
fromMaybe AppDirCustomize
noCustomization Maybe AppDirCustomize
appDirCustomize String
appDir [String]
args BuildFlags
flags PackageDescription
pkg LocalBuildInfo
buildInfo
    String -> Verbosity -> IO ()
bundleApp String
appDir Verbosity
verb

hasExecutable :: PackageDescription -> String -> Bool
hasExecutable :: PackageDescription -> String -> Bool
hasExecutable PackageDescription
pkg String
name =
  (Executable -> Bool) -> [Executable] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Executable
e -> Executable -> UnqualComponentName
exeName Executable
e UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> UnqualComponentName
forall a. IsString a => String -> a
fromString String
name) (PackageDescription -> [Executable]
executables PackageDescription
pkg)

deployExe :: FilePath -> AppImage -> FilePath -> Verbosity -> IO ()
deployExe :: String -> AppImage -> String -> Verbosity -> IO ()
deployExe String
exe AppImage{String
[String]
[(String, Maybe String)]
Maybe AppDirCustomize
appName :: AppImage -> String
appDesktop :: AppImage -> String
appIcons :: AppImage -> [String]
appResources :: AppImage -> [(String, Maybe String)]
appDirCustomize :: AppImage -> Maybe AppDirCustomize
appName :: String
appDesktop :: String
appIcons :: [String]
appResources :: [(String, Maybe String)]
appDirCustomize :: Maybe AppDirCustomize
..} String
appDir Verbosity
verb = do
  ConfiguredProgram
prog <- String -> Verbosity -> IO ConfiguredProgram
findProg String
"linuxdeploy" Verbosity
verb
  Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verb ConfiguredProgram
prog ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ String
"--appdir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appDir
    , String
"--executable=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exe
    , String
"--desktop-file=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appDesktop ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"--icon-file=" String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
appIcons

bundleFiles :: [(FilePath, Maybe FilePath)] -> FilePath -> Verbosity -> IO ()
bundleFiles :: [(String, Maybe String)] -> String -> Verbosity -> IO ()
bundleFiles [(String, Maybe String)]
files String
dest Verbosity
verb = IO ()
prepare IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((String, Maybe String) -> IO ())
-> [(String, Maybe String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> Maybe String -> IO ())
-> (String, Maybe String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Maybe String -> IO ()
copy) [(String, Maybe String)]
files
  where
    prepare :: IO ()
prepare = Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verb Bool
True String
dest

    copy :: String -> Maybe String -> IO ()
copy String
file Maybe String
destfile = do
      let fp :: String
fp = String
dest String -> String -> String
</> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
takeFileName String
file) Maybe String
destfile
      Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verb Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fp
      Verbosity -> String -> String -> IO ()
copyFileVerbose Verbosity
verb String
file String
fp

bundleApp :: FilePath -> Verbosity -> IO ()
bundleApp :: String -> Verbosity -> IO ()
bundleApp String
appDir Verbosity
verb = do
  ConfiguredProgram
prog <- String -> Verbosity -> IO ConfiguredProgram
findProg String
"appimagetool" Verbosity
verb
  let (String
wdir, String
name) = String -> (String, String)
splitFileName String
appDir
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verb (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
    (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [String
name]) { progInvokeCwd = Just wdir }

noCustomization :: AppDirCustomize
noCustomization :: AppDirCustomize
noCustomization String
_ [String]
_ BuildFlags
_ PackageDescription
_ LocalBuildInfo
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


findProg :: String -> Verbosity -> IO ConfiguredProgram
findProg :: String -> Verbosity -> IO ConfiguredProgram
findProg String
name Verbosity
verb = do
  Maybe (String, [String])
found <- Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
verb ProgramSearchPath
defaultProgramSearchPath String
name
  case Maybe (String, [String])
found of
    Maybe (String, [String])
Nothing        -> Verbosity -> String -> IO ConfiguredProgram
forall a. Verbosity -> String -> IO a
die' Verbosity
verb (String
"Command " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not available")
    Just (String
path, [String]
_) -> ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram String
name (String -> ProgramLocation
FoundOnSystem String
path))