hsinstall.hs

{-# LANGUAGE OverloadedRecordDot #-}

import Control.Monad (when)
import Formatting ((%), (%+), formatToString, string)
import System.Directory (copyFile, createDirectoryIfMissing,
  doesDirectoryExist, doesFileExist)
import System.Exit (exitSuccess)
import System.FilePath ((</>))
import System.IO (BufferMode (NoBuffering), hSetBuffering, stderr, stdout)
import System.Log.Logger

import HSInstall.AppImage (dumpStockIcon, mkAppImage, prepAppImageFiles,
  stockIconFilename)
import HSInstall.Build (BuildTool, clean, determineBuildTool,
  installBinaries, warnAboutCabalMultiExe)
import HSInstall.DeploymentInfo
  ( BinDir (..)
  , DeploymentInfo (binDir, docDir, packageName, prefixDir, tmplDir)
  , DocDir (..)
  , PrefixDir (..)
  , TmplDir (v)
  , constructDeploymentInfo
  )
import HSInstall.Except (withExceptionHandling)
import HSInstall.Log (initLogging, n)
import HSInstall.Opts
  ( BuildMode (AppImage, Dist)
  , Options (..)
  , Mode (..)
  , needCleaning
  , parseOpts
  )
import HSInstall.System.Directory (copyTree, warnAboutLegacyHsinstallDir)


{- HLINT ignore "Use record patterns" -}
main :: IO ()
main = do
  mapM_ (flip hSetBuffering NoBuffering) [ stdout, stderr ]

  opts@(Options mode _ _) <- parseOpts
  initLogging opts

  withExceptionHandling $ case mode of
    DumpIcon -> do
      dumpStockIcon Nothing
      noticeM n $ formatToString ("Saved icon file to ./" % string) stockIconFilename
      exitSuccess

    (Build buildMode) -> do
      warnAboutLegacyHsinstallDir

      buildTool <- determineBuildTool
      noticeM n $ formatToString ("Build tool detected:" %+ string) $ show buildTool

      warnAboutCabalMultiExe buildMode buildTool

      di <- constructDeploymentInfo buildTool buildMode

      when (needCleaning buildMode) $ clean buildTool
      deployApplication buildTool buildMode di

      case buildMode of
        (AppImage _ signing exeFile) ->
          prepAppImageFiles exeFile di >>= mkAppImage signing exeFile di
        (Dist _ _ _) -> return ()

      noticeM n "Successful!"


deployApplication :: BuildTool -> BuildMode -> DeploymentInfo -> IO ()
deployApplication buildTool mode di = do
  -- Copy the binaries
  let binFp = di.binDir.v
  createDirectoryIfMissing True binFp
  installBinaries buildTool mode di.packageName binFp

  -- Copy the license
  let licenseFile = "LICENSE"
  licenseFileExists <- doesFileExist licenseFile
  when licenseFileExists $ do
    noticeM n $ formatToString ("Copying" %+ string) licenseFile
    let docFp = di.docDir.v
    createDirectoryIfMissing True docFp
    copyFile licenseFile (docFp </> licenseFile)

  -- Copy the static template directory
  let tmplFp = (tmplDir di).v
  tmplExists <- doesDirectoryExist tmplFp
  when tmplExists $ do
    noticeM n $ formatToString ("Copying distribution files from template dir (" % string % ")") tmplFp
    copyTree False tmplFp di.prefixDir.v