Setup.hs

{-# LANGUAGE CPP #-}
import Data.Maybe(isJust, fromMaybe, maybeToList)
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.System
import Distribution.Simple.Setup
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Text ( display )
import Control.Monad
import Data.List
import Control.Applicative((<$>))
import Distribution.Simple.Configure(findDistPrefOrDefault)
import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )
import qualified Distribution.Simple.Register as Register
import Distribution.Simple.InstallDirs (fromPathTemplate)
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error
import System.Directory(getCurrentDirectory, copyFile, createDirectoryIfMissing, listDirectory, withCurrentDirectory, doesDirectoryExist, makeAbsolute, doesFileExist)
import System.FilePath ( (</>), (<.>), takeDirectory)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (ldOptions, extraGHCiLibraries, showInstalledPackageInfo, libraryDynDirs, libraryDirs,InstalledPackageInfo)
import System.Environment (getEnv, setEnv)

----------------------------------------
-- compatibility between Cabal 1 and Cabal 2

-- "If you have a custom-setup stanza, you should be able to use the MIN_VERSION_Cabal macro in your setup script."

-- cabal >=2.0.0.2
_FlagName :: String -> FlagName
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0)
_FlagName = mkFlagName
#else
_FlagName = FlagName
#endif

-- cabal >=2.0.1.1
_registerPackage :: Verbosity -> LocalBuildInfo -> PackageDBStack -> InstalledPackageInfo -> IO ()
#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,1)
_registerPackage verbosity lbi packageDbs installedPkgInfo
  = registerPackage verbosity (compiler lbi) (withPrograms lbi) packageDbs installedPkgInfo Register.defaultRegisterOptions
#else
_registerPackage verbosity lbi packageDbs installedPkgInfo
  = registerPackage verbosity (compiler lbi) (withPrograms lbi) False {- multiinstance -} packageDbs installedPkgInfo
#endif

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

main :: IO ()
main = defaultMainWithHooks autoconfUserHooks {
  preConf = myPreConf,
  postConf = myPostConf,
  buildHook = myBuildHook,
  cleanHook = myCleanHook,
  copyHook = copyCBindingsAndBundledExecutables,
  regHook = registerHook
  }

fltkSource = "fltk-master"
temporaryWorkaround = "temporary-workaround"

runMake :: FilePath -> [String] -> IO ()
runMake p args =
  withCurrentDirectory p
    (case buildOS of
    Windows -> rawSystemExit normal "make" args
    os | os `elem` [FreeBSD, OpenBSD, NetBSD, DragonFly]
      -> rawSystemExit normal "gmake" args
    _ -> rawSystemExit normal "make" args)

buildFltk :: IO FilePath -> Bool -> IO ()
buildFltk prefix openGL = do
  rawSystemExit normal "rm" ["-rf", fltkSource]
  rawSystemExit normal "unzip" [fltkSource ++ ".zip"]
  projectRoot <- getCurrentDirectory
  prefix' <- prefix
  let fltkDir = projectRoot </>  fltkSource
      fltkFlags = (if (openGL) then ["--enable-gl"] else ["--disable-gl"]) ++
                  [
                   "--enable-shared",
                   "--enable-localjpeg",
                   "--enable-localzlib",
                   "--enable-localpng",
                   "--enable-xft",
                   ("--prefix=" ++ prefix')
                  ]
  withCurrentDirectory
    fltkDir
    (
      let make = runMake fltkDir [] >> runMake fltkDir ["install"]
      in
      case buildOS of
        Windows -> do
          rawSystemExit normal "sh" ([(fltkDir </> "autogen.sh")] ++ fltkFlags)
          rawSystemExit normal "sh" ([(fltkDir </> "configure")] ++ fltkFlags)
          make
        _ -> do
          updateEnv "PATH" (projectRoot </> temporaryWorkaround)
          rawSystemExit normal (fltkDir </> "autogen.sh") fltkFlags
          rawSystemExit normal (fltkDir </> "configure") fltkFlags
          make
    )

myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo
myPreConf args flags = do
   if (bundledBuild flags)
    then do
      putStrLn "Building bundled FLTK"
      prefix <- bundlePrefix flags ""
      fltkBuilt <- doesDirectoryExist prefix
      if (not fltkBuilt)
        then buildFltk (case buildOS of { Windows -> cygpath "-u" prefix; _ -> return prefix;}) (openGLSupport flags)
        else putStrLn "FLTK already built."
      case buildOS of
        Windows -> updateEnv "PATH" (windowsFriendlyPaths (prefix </> "bin"))
        _ -> updateEnv "PATH" (prefix </> "bin")
    else return ()
   putStrLn "Running autoconf ..."
   case buildOS of
     Windows -> rawSystemExit normal "sh" ["autoconf"]
     _ -> rawSystemExit normal "autoconf" []
   fltkPathAdded <-
     if (bundledBuild flags)
     then do
       prefix <- bundlePrefix flags ""
       return flags{ configProgramPaths = [("fltk-config", prefix </> "bin" </> "fltk-config")] ++ (configProgramPaths flags)}
     else return flags
   preConf autoconfUserHooks args fltkPathAdded

myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostConf args flags pd lbi = do
  (major, minor, patch) <- getFltkVersion
  let confFlags = if (openGLSupport flags)
                  then (flags{ configConfigureArgs = (configConfigureArgs flags) ++ ["--enable-gl"]})
                  else flags
      confFlagsWithVersion =
        confFlags
        {
          configConfigureArgs = (configConfigureArgs confFlags) ++ [
                   ("--with-fltk-major-version=" ++ major),
                   ("--with-fltk-minor-version=" ++ minor),
                   ("--with-fltk-patch-version=" ++ patch)
                 ]
        }
      baseDir lbi' =
        case (cabalFilePath lbi') of
          Nothing -> ""
          Just p -> takeDirectory p
      basedir = baseDir lbi
      csrc = basedir </> "c-src"
  distBuild <- fmap (\d -> d </> "build") (findDistPrefOrDefault (configDistPref flags))
  srcFiles <- listDirectory csrc
  createDirectoryIfMissing False (distBuild </> "c-src")
  mapM_ (\f -> copyFile (csrc </> f) (distBuild </> "c-src" </> f)) srcFiles
  postConf autoconfUserHooks args confFlagsWithVersion pd lbi

fltkclib = "fltkc"

getFltkVersion :: IO (String, String, String)
getFltkVersion = do
  versionString <- (case buildOS of
                      Windows -> rawSystemStdout normal "sh" ["fltk-config", "--version"]
                      _ -> rawSystemStdout normal "fltk-config" ["--version"])
  return (fltkVersion versionString)

fltkVersion :: String -> (String,String,String)
fltkVersion version =
  let (major, minorVersion) = break ((==) '.') (unlines (lines version))
      (minor, patchVersion) = break ((==) '.') (drop 1 minorVersion)
      patch = drop 1 patchVersion
  in (major, minor, patch)

flagIsSet :: PD.FlagName -> ConfigFlags -> Bool
flagIsSet flag configFlags = maybe False id (lookupFlagAssignment flag (configConfigurationsFlags configFlags))


updateEnv :: String -> String -> IO ()
updateEnv env value = do
  old <- tryIOError (getEnv env)
  setEnv env ((either (const value)
                      (\old' -> value ++
                               (case buildOS of
                                  Windows -> ";"
                                  _ -> ":") ++
                               old'
                      )
                      old))


replaceAllInfixes :: String -> String -> String -> String
replaceAllInfixes needle subString haystack =
  concat
    (unfoldr (\str -> if (null str)
                      then Nothing
                      else if (needle `isPrefixOf` str)
                           then Just (subString, drop (length needle) str)
                           else Just ([head str], tail str))
             haystack)

bundledBuild flags = flagIsSet (_FlagName "bundled") flags
openGLSupport flags = flagIsSet (_FlagName "opengl") flags

bundlePrefix flags dir =
  let (Distribution.Simple.Setup.Flag prefixTemplate) = libdir (configInstallDirs flags)
  in
  makeAbsolute ((fromPathTemplate prefixTemplate) </> "fltk-bundled" </> dir)

cygpath o p =
  let removeTrailingNewline = head . lines  in
  removeTrailingNewline<$>(rawSystemStdout normal "cygpath" [o,  p])

windowsFriendlyPaths s =
  if (isPrefixOf "/" s)
  then unsafePerformIO (cygpath "-m" s)
  else s

getApiVersion :: IO Int
getApiVersion = do
  (major, minor, patch) <- getFltkVersion
  return ((((read major) :: Int) * 10000) +
            (((read minor) :: Int) * 100) +
            ((read patch) :: Int))

addApiVersion :: PackageDescription -> Int -> PackageDescription
addApiVersion pkg_descr apiVersion =
  let fixedLib =
        do
          l <- library pkg_descr
          let cpp = cppOptions (libBuildInfo l)
              -- have to add to ccOptions as well otherwise c2hs won't see it.
              cc = ccOptions (libBuildInfo l)
              fltkApiFlag = "-DFLTK_API_VERSION=" ++ (show apiVersion)
          return (l {
                      libBuildInfo =
                        (libBuildInfo l) {
                           cppOptions = cpp ++ [fltkApiFlag],
                           ccOptions = cc ++ [fltkApiFlag]
                        }
                   })
  in
  pkg_descr{ library = fixedLib }

getFltkcdir :: LocalBuildInfo -> FilePath
getFltkcdir lbi = (buildDir lbi) </> fltkclib

myBuildHook pkg_descr local_bld_info user_hooks bld_flags = do
     let confFlags = configFlags local_bld_info
         addFltkcDir :: FilePath -> PackageDescription -> PackageDescription
         addFltkcDir p pkg_descr =
           pkg_descr {
              library = fmap (\l' -> l' {
                                       libBuildInfo =
                                          (libBuildInfo l') {
                                             extraLibDirs = (extraLibDirs (libBuildInfo l')) ++ [p]
                                          }
                                     }
                             )
                             (library pkg_descr)
           }
     if (bundledBuild confFlags)
     then bundlePrefix confFlags "bin" >>=
          case buildOS of
            Windows -> updateEnv "PATH" . windowsFriendlyPaths
            _ -> updateEnv "PATH"
     else return ()
     let compileC = putStrLn "==Compiling C bindings==" >> runMake (buildDir local_bld_info) []
     let fltkcdir = (buildDir local_bld_info) </> "c-lib"
     cdirexists <- doesDirectoryExist fltkcdir
     if cdirexists
       then
       do
        clibraries <- listDirectory fltkcdir
        when (null $ filter (Data.List.isInfixOf "fltkc") clibraries) compileC
       else compileC
     apiVersion <- getApiVersion
     let apiVersionAddedPkgDescription = addApiVersion pkg_descr apiVersion
     case buildOS of
       Windows ->
         let rewritePaths :: PackageDescription -> IO PackageDescription
             rewritePaths pkg_descr =
               let lib = library pkg_descr
                   ld_incdirs :: Maybe ([String], [String])
                   ld_incdirs = fmap (\lib' -> (PD.ldOptions (libBuildInfo lib'), includeDirs (libBuildInfo lib')))  lib
                   stdCppGccPthreadPaths ghcPath =
                      [
                        ((takeDirectory . takeDirectory) ghcPath) </> "mingw" </> "lib" </> "gcc" </> "x86_64-w64-mingw32" </> "5.2.0"
                      , ((takeDirectory . takeDirectory) ghcPath) </> "mingw" </> "x86_64-w64-mingw32" </> "lib"
                      ]
               in
               do
                 ghcPath <- rawSystemStdout normal "sh" ["-c", "which ghc"]
                 cppGccPthreadPaths <- mapM (cygpath "-w") (stdCppGccPthreadPaths ghcPath)
                 bundledInclude <- if (bundledBuild confFlags)
                                   then fmap (\p -> [p]) ((bundlePrefix confFlags) "include")
                                   else return []
                 bundledLib <- if (bundledBuild confFlags)
                               then fmap (\p -> [p]) ((bundlePrefix confFlags) "lib")
                               else return []
                 let fixedLib = maybe Nothing
                                     (\(ld, incDirs) ->
                                          fmap (\l' -> l' {
                                                   libBuildInfo =
                                                     (libBuildInfo l') {
                                                        PD.ldOptions = fmap windowsFriendlyPaths ld,
                                                        includeDirs = fmap windowsFriendlyPaths (incDirs ++ bundledInclude ++ [(buildDir local_bld_info) </> "c-src"]),
                                                        extraLibDirs = cppGccPthreadPaths ++ (extraLibDirs (libBuildInfo l')) ++ bundledLib,
                                                        extraLibs = ["stdc++", "gcc", "pthread"]
                                                     }
                                                })
                                                lib
                                     )
                                     ld_incdirs
                 return (pkg_descr {library = fixedLib})
         in do
           fixedPkgDescr <- rewritePaths apiVersionAddedPkgDescription >>= return . (addFltkcDir fltkcdir)
           buildHook autoconfUserHooks fixedPkgDescr local_bld_info user_hooks bld_flags
       Linux -> do
         updateEnv "C_INCLUDE_PATH" ((buildDir local_bld_info) </> "c-src")
         updateEnv "LIBRARY_PATH" fltkcdir
         buildHook autoconfUserHooks apiVersionAddedPkgDescription local_bld_info user_hooks bld_flags
       _ -> do
         updateEnv "C_INCLUDE_PATH" ((buildDir local_bld_info) </> "c-src")
         updateEnv "DYLD_LIBRARY_PATH" fltkcdir
         updateEnv "LIBRARY_PATH" fltkcdir 
         buildHook autoconfUserHooks apiVersionAddedPkgDescription local_bld_info user_hooks bld_flags

copyCBindingsAndBundledExecutables :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
copyCBindingsAndBundledExecutables pkg_descr lbi uhs flags = do
    (copyHook autoconfUserHooks) pkg_descr lbi uhs flags
    let installDirs = absoluteInstallDirs pkg_descr lbi
                      . fromFlag . copyDest
                      $ flags
        libPref = libdir installDirs
    let p = (buildDir lbi) </> "c-lib"
    rawSystemExit (fromFlag $ copyVerbosity flags) "cp"
        [p </> "libfltkc.a" , libPref]
    case buildOS of
     OSX -> do
       updateEnv "DYLD_LIBRARY_PATH" (takeDirectory libPref)
       rawSystemExit
         (fromFlag $ copyVerbosity flags)
          "cp"
          [
            p </> "libfltkc-dyn.dylib"
          , libPref
          ]
     _ -> do
       updateEnv "LIBRARY_PATH" (takeDirectory libPref)
       rawSystemExit
         (fromFlag $ copyVerbosity flags) "cp"
         [
           p </> "libfltkc-dyn.so"
         , libPref
         ]
    if (bundledBuild (configFlags lbi))
    then do
      executableDir <- (bundlePrefix (configFlags lbi)) "bin"
      let binPref = bindir installDirs
      fluidExists <- doesFileExist (binPref </> "fluid")
      fltkConfigExists <- doesFileExist (binPref </> "fltk-config")
      if (not fluidExists)
      then rawSystemExit
               (fromFlag $ copyVerbosity flags) "cp"
               [(executableDir </> "fluid"), binPref]
      else return ()
      if (not fltkConfigExists)
      then rawSystemExit
               (fromFlag $ copyVerbosity flags) "cp"
               [(executableDir </> "fltk-config"), binPref]
      else return ()
    else return ()

myCleanHook pd x uh cf = do
  case buildOS of
   os | os `elem` [FreeBSD, OpenBSD, NetBSD, DragonFly]
     -> rawSystemExit normal "gmake" ["clean"]
   _ -> rawSystemExit normal "make" ["clean"]
  cleanHook autoconfUserHooks pd x uh cf

-- Based on code in "Gtk2HsSetup.hs" from "gtk" package
registerHook pkg_descr localbuildinfo _ flags =
    if hasLibs pkg_descr
    then register pkg_descr localbuildinfo flags
    else setupMessage verbosity
           "Package contains no library to register:" (packageId pkg_descr)
  where verbosity = fromFlag (regVerbosity flags)

register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
register pkg@PackageDescription { library = Just lib } lbi regFlags = do
  -- Libraries can have more than one target now due to Backpack, but we don't
  -- use it so we only register the library with a single target.
  case componentNameTargets' pkg lbi (CLibName (libName lib)) of
    [targetInfo] -> do
      let clbi = targetCLBI targetInfo
      installedPkgInfoRaw' <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace False distPref packageDb
      let installedPkgInfoRaw =
           case buildOS of
             Windows -> installedPkgInfoRaw' { Distribution.InstalledPackageInfo.ldOptions = fmap windowsFriendlyPaths (Distribution.InstalledPackageInfo.ldOptions installedPkgInfoRaw') }
             _ -> installedPkgInfoRaw'
      let installedPkgInfo = installedPkgInfoRaw {
                                  libraryDynDirs = (libraryDynDirs installedPkgInfoRaw) ++ (libraryDirs installedPkgInfoRaw),
                                  -- this is what this whole register code is all about
                                  extraGHCiLibraries =
                                    case buildOS of
                                      Windows -> ["libfltkc-dyn"]
                                      _ -> ["fltkc-dyn"]
                                  }

       -- Three different modes:
      case () of
       _ | modeGenerateRegFile   -> writeRegistrationFile installedPkgInfo
         | modeGenerateRegScript -> dieNoVerbosity "Generate Reg Script not supported"
         | otherwise             ->
            _registerPackage verbosity lbi packageDbs installedPkgInfo
    _ -> pure ()
  where
    modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
    regFile             = fromMaybe (display (packageId pkg) <.> "conf")
                                    (fromFlag (regGenPkgConf regFlags))
    modeGenerateRegScript = fromFlag (regGenScript regFlags)
    inplace   = fromFlag (regInPlace regFlags)
    packageDbs = nub $ withPackageDB lbi
                    ++ maybeToList (flagToMaybe  (regPackageDB regFlags))
    packageDb = registrationPackageDB packageDbs
    distPref  = fromFlag (regDistPref regFlags)
    verbosity = fromFlag (regVerbosity regFlags)

    writeRegistrationFile installedPkgInfo = do
      notice verbosity ("Creating package registration file: " ++ regFile)
      writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo)