{-# LANGUAGE CPP, OverloadedStrings #-}

{- |
   Module      : System.JBI.Commands.Cabal
   Description : cabal-install support
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : MIT
   Maintainer  : Ivan.Miljenovic@gmail.com



 -}
module System.JBI.Commands.Cabal
  ( Cabal
  , CabalMode
  , Sandbox
  , Nix
  ) where

import System.JBI.Commands.BuildTool
import System.JBI.Commands.Nix
import System.JBI.Commands.Tool
import System.JBI.Environment
import System.JBI.Tagged

import Control.Applicative (liftA2, (<*>))
import Control.Monad       (filterM)
import Data.Maybe          (isJust, maybeToList)
import Data.Proxy          (Proxy(Proxy))
import Data.Version        (makeVersion)
import System.Directory    (doesFileExist, getCurrentDirectory, listDirectory,
                            removeFile)
import System.Exit         (ExitCode, die, exitSuccess)
import System.FilePath     (takeExtension, (</>))
import System.IO.Error     (ioError, isDoesNotExistError, tryIOError)

import qualified Distribution.Package                  as CPkg
import           Distribution.PackageDescription       (GenericPackageDescription,
                                                        condBenchmarks,
                                                        condExecutables,
                                                        condLibrary,
                                                        condTestSuites)
import qualified Distribution.PackageDescription.Parse as CParse
import           Distribution.Verbosity                (silent)

#if MIN_VERSION_Cabal (2,0,0)
import Distribution.Types.UnqualComponentName (UnqualComponentName,
                                               unUnqualComponentName)
#endif

--------------------------------------------------------------------------------

data Cabal mode

instance Tool (Cabal mode) where
  commandName = "cabal"

instance (CabalMode mode) => BuildTool (Cabal mode) where
  canUseCommand = canUseMode

  commandProjectRoot = cabalProjectRoot

  hasBuildArtifacts = hasModeArtifacts

  commandPrepare = cabalPrepare

  commandTargets = cabalTargets

  commandBuild env cmd = cabalTry env cmd . cabalBuild env cmd

  commandRepl env cmd = cabalTry env cmd . cabalRepl env cmd

  commandClean = cabalClean

  commandTest = liftA2 (<*>) cabalTry cabalTest

  commandBench = liftA2 (<*>) cabalTry cabalBench

  commandExec = cabalExec

  commandRun env cmd = (cabalTry env cmd .) . cabalRun env cmd

  commandUpdate = cabalUpdate

cabalTry :: (CabalMode mode) => GlobalEnv -> Tagged (Cabal mode) CommandPath
            -> IO ExitCode -> IO ExitCode
cabalTry env cmd = tryCommand "Command failed, trying to re-configure"
                              (cabalConfigure env cmd)

instance (CabalMode mode) => NamedTool (Cabal mode) where
  prettyName p = "cabal+" ++ modeName (getMode p)

getMode :: proxy (Cabal mode) -> Proxy mode
getMode _ = Proxy

class CabalMode mode where
  modeName :: proxy mode -> String

  canUseMode :: GlobalEnv -> Installed (Cabal mode) -> IO Bool

  cabalProjectRoot :: Tagged (Cabal mode) CommandPath
                      -> IO (Maybe (Tagged (Cabal mode) ProjectRoot))
  cabalProjectRoot = withTaggedF go
    where
      -- Type signature needed to make withTaggedF happy, though we
      -- don't actually use the command itself for this.
      go :: FilePath -> IO (Maybe FilePath)
      go _ = recurseUpFindFile isCabalFile

  hasModeArtifacts :: Tagged (Cabal mode) ProjectRoot -> IO Bool

  cabalPrepare :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode

  cabalTargets :: Tagged (Cabal mode) CommandPath
                  -> IO [Tagged (Cabal mode) ProjectTarget]
  cabalTargets = withTaggedF go
    where
      -- Make withTaggedF happy
      go :: FilePath -> IO [String]
      go _ = cabalFileComponents

  -- | This is an additional function than found in 'BuildTool'.  May
  --   include installing dependencies.
  cabalConfigure :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode

  cabalBuild :: GlobalEnv -> Tagged (Cabal mode) CommandPath
                  -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
  cabalBuild = commandArgTarget "build"

  cabalRepl :: GlobalEnv -> Tagged (Cabal mode) CommandPath
               -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
  cabalRepl = commandArgsTarget ["repl", "--ghc-options=-ferror-spans"]

  cabalClean :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode

  cabalTest :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode
  cabalTest = commandArg "test"

  cabalBench :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode
  cabalBench = commandArg "bench"

  cabalExec :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> String -> Args -> IO ExitCode
  cabalExec env cmd prog progArgs = commandArgs args env cmd
    where
      args = "exec" : prog : "--" : progArgs

  cabalRun :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> Tagged (Cabal mode) ProjectTarget
              -> Args -> IO ExitCode
  cabalRun env cmd prog progArgs = commandArgs args env cmd
    where
      args = "run" : componentName (stripTag prog) : "--" : progArgs

  cabalUpdate :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode
  cabalUpdate = commandArg "update"

--------------------------------------------------------------------------------

data Sandbox

instance CabalMode Sandbox where
  modeName _ = "sandbox"

  canUseMode env inst = return (isJust (ghc env)
                                && maybe True ((>= makeVersion [1,18]) . stripTag)
                                              (version inst))

  hasModeArtifacts pr = doesFileExist (stripTag pr </> "cabal.sandbox.config")

  cabalPrepare = commandArgs ["sandbox", "init"]

  cabalConfigure env cmd = tryConfigure
    where
      install = commandArgs ["install", "--only-dependencies"
                            , "--enable-tests", "--enable-benchmarks"]
                            env cmd

      tryInstall = tryCommand "Installation failed; updating index."
                              (cabalUpdate env cmd)
                              install

      tryConfigure = tryCommand "Configuring failed; checking dependencies"
                                tryInstall
                                configure

      configure = commandArgs ["configure", "--enable-tests", "--enable-benchmarks"]
                              env cmd

  -- Note: we don't treat "dist" as part of the tool artifacts, but it
  -- doesn't make sense without the sandbox so remove it as well.
  cabalClean env cmd = commandArg "clean" env cmd
                       .&&. commandArgs ["sandbox", "delete"] env cmd

--------------------------------------------------------------------------------

data Nix

instance CabalMode Nix where
  modeName _ = "nix"

  canUseMode env _ = return (liftA2 (&&) (isJust . nixShell) (isJust . cabal2Nix) (nix env))

  hasModeArtifacts pr = or <$> mapM (doesFileExist . (stripTag pr </>))
                                    ["shell.nix", "default.nix"]

  -- Note that commandPrepare is meant to be run within ProjectRoot
  cabalPrepare env _ = case path <$> cabal2Nix (nix env) of
                         Nothing  -> die "cabal2Nix required"
                         Just c2n -> tryRunToFile "shell.nix" c2n ["--shell", "."]

  cabalConfigure env _ = case path <$> nixShell (nix env) of
                           Nothing -> die "nix-shell required"
                           Just ns -> tryRun ns ["--run", "cabal configure --enable-tests --enable-benchmarks"]

  cabalClean env cmd = commandArg "clean" env cmd
                       .&&. rmFile "shell.nix"
                       .&&. rmFile "default.nix"
    where
      rmFile file = do
        rmStatus <- tryIOError (removeFile file)
        case rmStatus of
          -- We're guessing as to which file is the one being used
          -- here, so an error because a file doesn't exist is OK;
          -- anything else is serious and should be re-thrown.
          Left err | not (isDoesNotExistError err) -> ioError err
          _        -> exitSuccess

--------------------------------------------------------------------------------

isCabalFile :: FilePath -> Bool
isCabalFile = (== ".cabal") . takeExtension

--------------------------------------------------------------------------------
-- The Cabal library likes to really keep changing things...

cabalFileComponents :: IO [String]
cabalFileComponents = do
  dir   <- getCurrentDirectory
  cntns <- map (dir </>) <$> listDirectory dir
  files <- filterM doesFileExist cntns
  let cabalFiles = filter isCabalFile files
  case cabalFiles of
    []    -> return []
    (c:_) -> getComponents <$> parseCabalFile c

parseCabalFile :: FilePath -> IO GenericPackageDescription
parseCabalFile =
#if MIN_VERSION_Cabal(2,0,0)
  CParse.readGenericPackageDescription
#else
  CParse.readPackageDescription
#endif
    silent

type ComponentName =
#if MIN_VERSION_Cabal (2,0,0)
  UnqualComponentName
#else
  String
#endif

rawComponentName :: ComponentName -> String
rawComponentName =
#if MIN_VERSION_Cabal (2,0,0)
  unUnqualComponentName
#else
  id
#endif

packageName :: GenericPackageDescription -> String
packageName =
#if MIN_VERSION_Cabal (2,0,0)
  CPkg.unPackageName
#else
  (\(CPkg.PackageName nm) -> nm)
#endif
  . CPkg.packageName

getComponents :: GenericPackageDescription -> [String]
getComponents gpd = concat
                      [ getLib
                      , getType condExecutables "exe"
                      , getType condTestSuites  "test"
                      , getType condBenchmarks  "bench"
                      ]
  where
    pkgName = packageName gpd

    getLib
      | isJust (condLibrary gpd) = ["lib:" ++ pkgName]
      | otherwise                = []

    getType f typ = map (\cmp -> typ ++ ':' : rawComponentName (fst cmp)) (f gpd)

--------------------------------------------------------------------------------

commandArgsTarget :: Args -> GlobalEnv -> Tagged (Cabal mode) CommandPath
                     -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
commandArgsTarget args env cmd mt = commandArgs args' env cmd
  where
    args' = args ++ maybeToList (fmap stripTag mt)

commandArgTarget :: String -> GlobalEnv -> Tagged (Cabal mode) CommandPath
                    -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
commandArgTarget = commandArgsTarget . (:[])

commandArg :: String -> GlobalEnv -> Tagged (Cabal mode) CommandPath
              -> IO ExitCode
commandArg arg = commandArgs [arg]

commandArgs :: Args -> GlobalEnv -> Tagged (Cabal mode) CommandPath
               -> IO ExitCode
commandArgs args _env cmd = tryRun cmd args