-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.JHC
-- Copyright   :  Isaac Jones 2003-2006
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains most of the JHC-specific code for configuring, building
-- and installing packages.

module Distribution.Simple.JHC (
        configure, getInstalledPackages,
        buildLib, buildExe,
        installLib, installExe
 ) where

import Distribution.PackageDescription as PD
       ( PackageDescription(..), BuildInfo(..), Executable(..)
       , Library(..), libModules, hcOptions, usedExtensions )
import Distribution.InstalledPackageInfo
         ( emptyInstalledPackageInfo, )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
                                ( autogenModulesDir, exeExtension )
import Distribution.Simple.Compiler
         ( CompilerFlavor(..), CompilerId(..), Compiler(..), AbiTag(..)
         , PackageDBStack, Flag, languageToFlags, extensionsToFlags )
import Language.Haskell.Extension
         ( Language(Haskell98), Extension(..), KnownExtension(..))
import Distribution.Simple.Program
         ( ConfiguredProgram(..), jhcProgram, ProgramConfiguration
         , userMaybeSpecifyPath, requireProgramVersion, lookupProgram
         , rawSystemProgram, rawSystemProgramStdoutConf )
import Distribution.Version
         ( Version(..), orLaterVersion )
import Distribution.Package
         ( Package(..), InstalledPackageId(InstalledPackageId),
           pkgName, pkgVersion, )
import Distribution.Simple.Utils
        ( createDirectoryIfMissingVerbose, writeFileAtomic
        , installOrdinaryFile, installExecutableFile
        , intercalate )
import System.FilePath          ( (</>) )
import Distribution.Verbosity
import Distribution.Text
         ( Text(parse), display )
import Distribution.Compat.ReadP
    ( readP_to_S, string, skipSpaces )
import Distribution.System ( Platform )

import Data.List                ( nub )
import Data.Char                ( isSpace )
import qualified Data.Map as M  ( empty )
import Data.Maybe               ( fromMaybe )

import qualified Data.ByteString.Lazy.Char8 as BS.Char8


-- -----------------------------------------------------------------------------
-- Configuring

configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
          -> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration)
configure verbosity hcPath _hcPkgPath conf = do

  (jhcProg, _, conf') <- requireProgramVersion verbosity
                           jhcProgram (orLaterVersion (Version [0,7,2] []))
                           (userMaybeSpecifyPath "jhc" hcPath conf)

  let Just version = programVersion jhcProg
      comp = Compiler {
        compilerId             = CompilerId JHC version,
        compilerAbiTag         = NoAbiTag,
        compilerCompat         = [],
        compilerLanguages      = jhcLanguages,
        compilerExtensions     = jhcLanguageExtensions,
        compilerProperties     = M.empty
      }
      compPlatform = Nothing
  return (comp, compPlatform, conf')

jhcLanguages :: [(Language, Flag)]
jhcLanguages = [(Haskell98, "")]

-- | The flags for the supported extensions
jhcLanguageExtensions :: [(Extension, Flag)]
jhcLanguageExtensions =
    [(EnableExtension  TypeSynonymInstances       , "")
    ,(DisableExtension TypeSynonymInstances       , "")
    ,(EnableExtension  ForeignFunctionInterface   , "")
    ,(DisableExtension ForeignFunctionInterface   , "")
    ,(EnableExtension  ImplicitPrelude            , "") -- Wrong
    ,(DisableExtension ImplicitPrelude            , "--noprelude")
    ,(EnableExtension  CPP                        , "-fcpp")
    ,(DisableExtension CPP                        , "-fno-cpp")
    ]

getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
                    -> IO InstalledPackageIndex
getInstalledPackages verbosity _packageDBs conf = do
   -- jhc --list-libraries lists all available libraries.
   -- How shall I find out, whether they are global or local
   -- without checking all files and locations?
   str <- rawSystemProgramStdoutConf verbosity jhcProgram conf ["--list-libraries"]
   let pCheck :: [(a, String)] -> [a]
       pCheck rs = [ r | (r,s) <- rs, all isSpace s ]
   let parseLine ln =
          pCheck (readP_to_S
             (skipSpaces >> string "Name:" >> skipSpaces >> parse) ln)
   return $
      PackageIndex.fromList $
      map (\p -> emptyInstalledPackageInfo {
                    InstalledPackageInfo.installedPackageId =
                       InstalledPackageId (display p),
                    InstalledPackageInfo.sourcePackageId = p
                 }) $
      concatMap parseLine $
      lines str

-- -----------------------------------------------------------------------------
-- Building

-- | Building a package for JHC.
-- Currently C source files are not supported.
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
  let Just jhcProg = lookupProgram jhcProgram (withPrograms lbi)
  let libBi = libBuildInfo lib
  let args  = constructJHCCmdLine lbi libBi clbi (buildDir lbi) verbosity
  let pkgid = display (packageId pkg_descr)
      pfile = buildDir lbi </> "jhc-pkg.conf"
      hlfile= buildDir lbi </> (pkgid ++ ".hl")
  writeFileAtomic pfile . BS.Char8.pack $ jhcPkgConf pkg_descr
  rawSystemProgram verbosity jhcProg $
     ["--build-hl="++pfile, "-o", hlfile] ++
     args ++ map display (libModules lib)

-- | Building an executable for JHC.
-- Currently C source files are not supported.
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi exe clbi = do
  let Just jhcProg = lookupProgram jhcProgram (withPrograms lbi)
  let exeBi = buildInfo exe
  let out   = buildDir lbi </> exeName exe
  let args  = constructJHCCmdLine lbi exeBi clbi (buildDir lbi) verbosity
  rawSystemProgram verbosity jhcProg (["-o",out] ++ args ++ [modulePath exe])

constructJHCCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
                    -> FilePath -> Verbosity -> [String]
constructJHCCmdLine lbi bi clbi _odir verbosity =
        (if verbosity >= deafening then ["-v"] else [])
     ++ hcOptions JHC bi
     ++ languageToFlags (compiler lbi) (defaultLanguage bi)
     ++ extensionsToFlags (compiler lbi) (usedExtensions bi)
     ++ ["--noauto","-i-"]
     ++ concat [["-i", l] | l <- nub (hsSourceDirs bi)]
     ++ ["-i", autogenModulesDir lbi]
     ++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
     -- It would be better if JHC would accept package names with versions,
     -- but JHC-0.7.2 doesn't accept this.
     -- Thus, we have to strip the version with 'pkgName'.
     ++ (concat [ ["-p", display (pkgName pkgid)]
                | (_, pkgid) <- componentPackageDeps clbi ])

jhcPkgConf :: PackageDescription -> String
jhcPkgConf pd =
  let sline name sel = name ++ ": "++sel pd
      lib = fromMaybe (error "no library available") . library
      comma = intercalate "," . map display
  in unlines [sline "name" (display . pkgName . packageId)
             ,sline "version" (display . pkgVersion . packageId)
             ,sline "exposed-modules" (comma . PD.exposedModules . lib)
             ,sline "hidden-modules" (comma . otherModules . libBuildInfo . lib)
             ]

installLib :: Verbosity -> FilePath -> FilePath -> PackageDescription -> Library -> IO ()
installLib verb dest build_dir pkg_descr _ = do
    let p = display (packageId pkg_descr)++".hl"
    createDirectoryIfMissingVerbose verb True dest
    installOrdinaryFile verb (build_dir </> p) (dest </> p)

installExe :: Verbosity -> FilePath -> FilePath -> (FilePath,FilePath) -> PackageDescription -> Executable -> IO ()
installExe verb dest build_dir (progprefix,progsuffix) _ exe = do
    let exe_name = exeName exe
        src = exe_name </> exeExtension
        out   = (progprefix ++ exe_name ++ progsuffix) </> exeExtension
    createDirectoryIfMissingVerbose verb True dest
    installExecutableFile verb (build_dir </> src) (dest </> out)