DeploymentInfo.hs

{-# LANGUAGE DuplicateRecordFields #-}

module HSInstall.DeploymentInfo
  ( BinDir (..)
  , DeploymentInfo (..)
  , DocDir (..)
  , PrefixDir (..)
  , TmplDir (..)
  , constructDeploymentInfo

  -- re-exporting
  , normal
  , prettyShow
  )
  where

import Control.Applicative ((<|>))
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.List (find, isSuffixOf)
import Distribution.Package
  ( PackageId
  , PackageIdentifier (pkgName, pkgVersion)
  )
import Distribution.PackageDescription
  ( GenericPackageDescription (packageDescription)
  , PackageDescription (package)
  )
import Distribution.Pretty (prettyShow)
import Distribution.Simple.PackageDescription (readGenericPackageDescription)
import Distribution.Types.PackageName (unPackageName)
import Distribution.Types.Version (Version)
import Distribution.Utils.Path (makeSymbolicPath)
import Distribution.Verbosity (normal)
import System.Directory (getDirectoryContents)
import System.FilePath ((</>), (<.>))

import HSInstall.Build (BuildTool, PackageName (..), makeCabal)
import HSInstall.Except (HSInstallException (NoCabalFiles), throwM)
import HSInstall.Opts (BuildMode (AppImage, Dist), ExeFile (..),
  PrefixOpt (..))


newtype TmplDir = TmplDir { v :: FilePath }

newtype PrefixDir = PrefixDir { v :: FilePath }

newtype BinDir = BinDir { v :: FilePath }

newtype DocDir = DocDir { v :: FilePath }

data DeploymentInfo = DeploymentInfo
  { prefixDir :: PrefixDir
  , binDir :: BinDir
  , docDir :: DocDir
  , version :: Version
  , tmplDir :: TmplDir
  , packageName :: PackageName
  }


-- This tool is designed to only be run in the top-level directory of a Haskell
-- package that's being packaged for deployment.
cwd :: FilePath
cwd = "."


locateCabalFile :: IO (Maybe FilePath)
locateCabalFile = find (isSuffixOf ".cabal") <$> getDirectoryContents cwd


constructDeploymentInfo :: BuildTool -> BuildMode -> IO DeploymentInfo
constructDeploymentInfo buildTool buildMode = do
  mbCabalFile <- runMaybeT
    $   MaybeT locateCabalFile
    <|> MaybeT (makeCabal buildTool >> locateCabalFile)
  let path = Just $ makeSymbolicPath cwd
  maybe (throwM NoCabalFiles)
    (fmap (constructDeploymentInfo' buildMode . package . packageDescription)
      . readGenericPackageDescription normal path . makeSymbolicPath) mbCabalFile


constructDeploymentInfo' :: BuildMode -> PackageId -> DeploymentInfo
constructDeploymentInfo' buildMode pkgId =
  DeploymentInfo prefixDir' (BinDir binFp)
    (DocDir $ shareFp </> "doc") (pkgVersion pkgId)
    (mkTmplDirPath buildMode) (PackageName project)

  where
    prefixDir'@(PrefixDir prefixFp) = computePrefixDir buildMode
    binFp = prefixFp </> "bin"
    project = unPackageName . pkgName $ pkgId
    shareFp = prefixFp </> "share" </> project


workingDirPrefix :: FilePath
workingDirPrefix = "hsi-"


computePrefixDir :: BuildMode -> PrefixDir
computePrefixDir (AppImage _ _ (ExeFile exeFp)) =
  PrefixDir $ workingDirPrefix <> "AppDir" <.> exeFp </> "usr"
computePrefixDir (Dist _ NoPrefixSpecified _) = PrefixDir $ workingDirPrefix <> "dist" </> "usr"
computePrefixDir (Dist _ (Prefix prefixFp) _) = PrefixDir prefixFp


tmplDirPrefix :: FilePath
tmplDirPrefix = workingDirPrefix <> "tmpl"

{- HLINT ignore "Use record patterns" -}
mkTmplDirPath :: BuildMode -> TmplDir
mkTmplDirPath (AppImage _ _ (ExeFile exeFp)) = TmplDir $ "." </> tmplDirPrefix <.> exeFp
mkTmplDirPath (Dist _ _ _)                   = TmplDir $ "." </> tmplDirPrefix