module Actions ( cabalUpdate
               , installCabalConfig
               , installCabalWrapper
               , installActivateScript
               , copyBaseSystem
               , initGhcDb
               , installGhc
               , createDirStructure
               ) where

import System.Directory (setCurrentDirectory, getCurrentDirectory, createDirectory, removeDirectoryRecursive)
import System.FilePath ((</>))
import Distribution.Version (Version (..))
import Distribution.Package (PackageName(..))
import Safe (lastMay)
import Data.List (intercalate)

import MyMonad
import Types
import Paths
import PackageManagement
import Process
import Util.Template (substs)
import Util.IO (makeExecutable, createTemporaryDirectory)
import Skeletons

-- update cabal package info inside Virtual Haskell Environmentn
cabalUpdate :: MyMonad ()
cabalUpdate = do
  env         <- getVirtualEnvironment
  cabalConfig <- cabalConfigLocation
  info "Updating cabal package database inside Virtual Haskell Environment."
  _ <- indentMessages $ runProcess (Just env) "cabal" ["--config-file=" ++ cabalConfig, "update"] Nothing
  return ()

-- install cabal wrapper (in bin/ directory) inside virtual environment dir structure
installCabalWrapper :: MyMonad ()
installCabalWrapper = do
  cabalConfig      <- cabalConfigLocation
  dirStructure     <- vheDirStructure
  let cabalWrapper = virthualEnvBinDir dirStructure </> "cabal"
  info $ concat [ "Installing cabal wrapper using "
                , cabalConfig
                , " at "
                , cabalWrapper
                ]
  let cabalWrapperContents = substs [("<CABAL_CONFIG>", cabalConfig)] cabalWrapperSkel
  indentMessages $ do
    trace "cabal wrapper contents:"
    indentMessages $ mapM_ trace $ lines cabalWrapperContents
  liftIO $ writeFile cabalWrapper cabalWrapperContents
  liftIO $ makeExecutable cabalWrapper

installActivateScriptSupportFiles :: MyMonad ()
installActivateScriptSupportFiles = do
  debug "installing supporting files"
  dirStructure <- vheDirStructure
  ghc <- asks ghcSource
  indentMessages $ do
    let pathVarPrependixLocation = virthualEnvDir dirStructure </> "path_var_prependix"
        pathVarElems =
            case ghc of
              System    -> [virthualEnvBinDir dirStructure, cabalBinDir dirStructure]
              Tarball _ -> [ virthualEnvBinDir dirStructure
                          , cabalBinDir dirStructure
                          , ghcBinDir dirStructure
                          ]
        pathVarPrependix = intercalate ":" pathVarElems
    debug $ "installing path_var_prependix file to " ++ pathVarPrependixLocation
    indentMessages $ trace $ "path_var_prependix contents: " ++ pathVarPrependix
    liftIO $ writeFile pathVarPrependixLocation pathVarPrependix
    ghcPkgDbPath <- indentMessages ghcPkgDbPathLocation
    let ghcPackagePathVarLocation = virthualEnvDir dirStructure </> "ghc_package_path_var"
        ghcPackagePathVar         = ghcPkgDbPath
    debug $ "installing ghc_package_path_var file to " ++ ghcPackagePathVarLocation
    indentMessages $ trace $ "path_var_prependix contents: " ++ ghcPackagePathVar
    liftIO $ writeFile ghcPackagePathVarLocation ghcPackagePathVar

-- install activate script (in bin/ directory) inside virtual environment dir structure
installActivateScript :: MyMonad ()
installActivateScript = do
  info "Installing activate script"
  virthualEnvName <- asks vheName
  dirStructure    <- vheDirStructure
  ghcPkgDbPath    <- indentMessages ghcPkgDbPathLocation
  let activateScript = virthualEnvBinDir dirStructure </> "activate"
  indentMessages $ debug $ "using location: " ++ activateScript
  let activateScriptContents = substs [ ("<VIRTHUALENV_NAME>", virthualEnvName)
                                      , ("<VIRTHUALENV_DIR>", virthualEnvDir dirStructure)
                                      , ("<VIRTHUALENV>", virthualEnv dirStructure)
                                      , ("<GHC_PACKAGE_PATH>", ghcPkgDbPath)
                                      , ("<VIRTHUALENV_BIN_DIR>", virthualEnvBinDir dirStructure)
                                      , ("<CABAL_BIN_DIR>", cabalBinDir dirStructure)
                                      , ("<GHC_BIN_DIR>", ghcBinDir dirStructure)
                                      ] activateSkel
  indentMessages $ do
    trace "activate script contents:"
    indentMessages $ mapM_ trace $ lines activateScriptContents
  liftIO $ writeFile activateScript activateScriptContents
  indentMessages installActivateScriptSupportFiles

-- install cabal's config file (in cabal/ directory) inside virtual environment dir structure
installCabalConfig :: MyMonad ()
installCabalConfig = do
  cabalConfig     <- cabalConfigLocation
  dirStructure    <- vheDirStructure
  info $ "Installing cabal config at " ++ cabalConfig
  let cabalConfigContents = substs [ ("<GHC_PACKAGE_PATH>", ghcPackagePath dirStructure)
                                   , ("<CABAL_DIR>", cabalDir dirStructure)
                                   ] cabalConfigSkel
  indentMessages $ do
    trace "cabal config contents:"
    indentMessages $ mapM_ trace $ lines cabalConfigContents
  liftIO $ writeFile cabalConfig cabalConfigContents

createDirStructure :: MyMonad ()
createDirStructure = do
  dirStructure <- vheDirStructure
  info "Creating Virtual Haskell directory structure"
  indentMessages $ do
    debug $ "virthualenv directory: " ++ virthualEnvDir dirStructure
    liftIO $ createDirectory $ virthualEnvDir dirStructure
    debug $ "cabal directory: " ++ cabalDir dirStructure
    liftIO $ createDirectory $ cabalDir dirStructure
    debug $ "virthualenv bin directory: " ++ virthualEnvBinDir dirStructure
    liftIO $ createDirectory $ virthualEnvBinDir dirStructure

-- initialize private GHC package database inside virtual environment
initGhcDb :: MyMonad ()
initGhcDb = do
  dirStructure <- vheDirStructure
  info $ "Initializing GHC Package database at " ++ ghcPackagePath dirStructure
  out <- indentMessages $ outsideGhcPkg ["--version"]
  case lastMay $ words out of
    Nothing            -> throwError $ MyException $ "Couldn't extract ghc-pkg version number from: " ++ out
    Just versionString -> do
      indentMessages $ trace $ "Found version string: " ++ versionString
      version <- parseVersion versionString
      let ghc_6_12_1_version = Version [6,12,1] []
      if version < ghc_6_12_1_version then do
        indentMessages $ debug "Detected GHC older than 6.12, initializing GHC_PACKAGE_PATH to file with '[]'"
        liftIO $ writeFile (ghcPackagePath dirStructure) "[]"
       else do
        _ <- indentMessages $ outsideGhcPkg ["init", ghcPackagePath dirStructure]
        return ()

-- copy optional packages and don't fail completely if this copying fails
-- some packages mail fail to copy and it's not fatal (e.g. older GHCs don't have haskell2010)
transplantOptionalPackage :: String -> MyMonad ()
transplantOptionalPackage name = transplantPackage (PackageName name) `catchError` handler
  where handler e = do
          warning $ "Failed to copy optional package " ++ name ++ " from system's GHC: "
          indentMessages $ warning $ getExceptionMessage e

-- copy base system
-- base - needed for ghci and everything else
-- Cabal - needed to install non-trivial cabal packages with cabal-install
-- haskell98 - some packages need it but they don't specify it (seems it's an implicit dependancy)
-- haskell2010 - maybe it's similar to haskell98?
-- ghc and ghc-binary - two packages that are provided with GHC and cannot be installed any other way
-- also include dependant packages of all the above
-- when using GHC from tarball, just reuse its package database
-- cannot do the same when using system's GHC, because there might be additional packages installed
-- then it wouldn't be possible to work on them insie virtual environment
copyBaseSystem :: MyMonad ()
copyBaseSystem = do
  info "Copying necessary packages from original GHC package database"
  indentMessages $ do
    ghc <- asks ghcSource
    case ghc of
      System -> do
        transplantPackage $ PackageName "base"
        transplantPackage $ PackageName "Cabal"
        mapM_ transplantOptionalPackage ["haskell98", "haskell2010", "ghc", "ghc-binary"]
      Tarball _ ->
        debug "Using external GHC - nothing to copy, Virtual environment will reuse GHC package database"

installGhc :: MyMonad ()
installGhc = do
  info "Installing GHC"
  ghc <- asks ghcSource
  case ghc of
    System              -> indentMessages $ debug "Using system version of GHC - nothing to install."
    Tarball tarballPath -> indentMessages $ installExternalGhc tarballPath

installExternalGhc :: FilePath -> MyMonad ()
installExternalGhc tarballPath = do
  info $ "Installing GHC from " ++ tarballPath
  indentMessages $ do
    dirStructure <- vheDirStructure
    tmpGhcDir <- liftIO $ createTemporaryDirectory (virthualEnv dirStructure) "ghc"
    debug $ "Unpacking GHC tarball to " ++ tmpGhcDir
    _ <- indentMessages $ runProcess Nothing "tar" ["xf", tarballPath, "-C", tmpGhcDir, "--strip-components", "1"] Nothing
    let configureScript = tmpGhcDir </> "configure"
    debug $ "Configuring GHC with prefix " ++ ghcDir dirStructure
    cwd <- liftIO getCurrentDirectory
    liftIO $ setCurrentDirectory tmpGhcDir
    make <- asks makeCmd
    let configureAndInstall = do
          _ <- indentMessages $ runProcess Nothing configureScript ["--prefix=" ++ ghcDir dirStructure] Nothing
          debug $ "Installing GHC with " ++ make ++ " install"
          _ <- indentMessages $ runProcess Nothing make ["install"] Nothing
          return ()
    configureAndInstall `finally` liftIO (setCurrentDirectory cwd)
    liftIO $ removeDirectoryRecursive tmpGhcDir
    return ()