<commit_before>-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015  <NAME> <dxld ÄT darkboxed DOT org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE RecordWildCards, FlexibleContexts #-}
module CabalHelper.Compiletime.Compile where

import Control.Applicative
import Control.Arrow
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Traversable
import Data.Char
import Data.List
import Data.Maybe
import Data.String
import Data.Version
import Text.Printf
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import System.IO
import System.IO.Temp
import Prelude

import Distribution.System (buildPlatform)
import Distribution.Text (display)

import Paths_cabal_helper (version)
import CabalHelper.Compiletime.Data
import CabalHelper.Compiletime.Log
import CabalHelper.Shared.Common
import CabalHelper.Shared.Sandbox (getSandboxPkgDb)
import CabalHelper.Shared.Types

data Compile = Compile {
      compCabalSourceDir :: Maybe FilePath,
      compPackageDb      :: Maybe FilePath,
      compCabalVersion   :: Either String Version,
      compPackageDeps    :: [String]
    }

compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath)
compileHelper opts cabalVer projdir distdir = do
  case cabalPkgDb opts of
    Nothing ->
      run [
            -- TODO: here ghc's caching fails and it always recompiles, probably
            -- because we write the sources to a tempdir and they always look
            -- newer than the Cabal sources, not sure if we can fix this
            compileCabalSource
          , Right <$> MaybeT (cachedExe cabalVer)
          , compileSandbox
          , compileGlobal
          , cachedCabalPkg
          , MaybeT (Just <$> compilePrivatePkgDb)
          ]
    mdb ->
      run [ Right <$> MaybeT (cachedExe cabalVer)
          , liftIO $ compileWithPkg mdb cabalVer
          ]

 where
   run actions = fromJust <$> runMaybeT (msum actions)

   logMsg = "compiling helper with Cabal from "

-- for relaxed deps: find (sameMajorVersionAs cabalVer) . reverse . sort

   -- | Check if this version is globally available
   compileGlobal :: MaybeT IO (Either ExitCode FilePath)
   compileGlobal = do
       ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts
       vLog opts $ logMsg ++ "user/global package-db"
       liftIO $ compileWithPkg Nothing ver

   -- | Check if this version is available in the project sandbox
   compileSandbox :: MaybeT IO (Either ExitCode FilePath)
   compileSandbox = do
       sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts
       ver <- MaybeT $ logSomeError opts "compileSandbox" $
         find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)
       vLog opts $ logMsg ++ "sandbox package-db"
       liftIO $ compileWithPkg (Just sandbox) ver


   -- | Check if we already compiled this version of cabal into a private
   -- package-db
   cachedCabalPkg :: MaybeT IO (Either ExitCode FilePath)
   cachedCabalPkg = do
       db_exists <- liftIO $ cabalPkgDbExists opts cabalVer
       case db_exists of
         False -> mzero
         True -> do
             db <- liftIO $ getPrivateCabalPkgDb opts (Right cabalVer)
             vLog opts $ logMsg ++ "private package-db in " ++ db
             liftIO $ compileWithPkg (Just db) cabalVer

   -- | See if we're in a cabal source tree
   compileCabalSource :: MaybeT IO (Either ExitCode FilePath)
   compileCabalSource = do
       let cabalFile = projdir </> "Cabal.cabal"
       cabalSrc <- liftIO $ doesFileExist cabalFile
       case cabalSrc of
         False -> mzero
         True -> liftIO $ do
           vLog opts $ "directory above distdir looks like cabal source tree (Cabal.cabal exists)"
           ver <- cabalFileVersion <$> readFile cabalFile
           vLog opts $ "compiling helper with local Cabal source tree"
           compileWithCabalTree ver projdir

   -- | Compile the requested cabal version into an isolated package-db
   compilePrivatePkgDb :: IO (Either ExitCode FilePath)
   compilePrivatePkgDb = do
       db <- installCabal opts cabalVer `E.catch`
             \(SomeException _) -> errorInstallCabal cabalVer distdir
       compileWithPkg (Just db) cabalVer

   compileWithCabalTree ver srcDir =
       compile distdir opts $ Compile {
                     compCabalSourceDir       = Just srcDir,
                     compPackageDb            = Nothing,
                     compCabalVersion         = Right ver,
                     compPackageDeps          = []
                   }

   compileWithPkg mdb ver =
       compile distdir opts $ Compile {
                     compCabalSourceDir       = Nothing,
                     compPackageDb            = mdb,
                     compCabalVersion         = Right ver,
                     compPackageDeps          = [cabalPkgId ver]
                   }

   cabalPkgId v = "Cabal-" ++ showVersion v

compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath)
compile distdir opts@Options {..} Compile {..} = do
    cnCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir
    appdir <- appCacheDir

    let (outdir, exedir, exe, mchsrcdir) =
          case cnCabalSourceDir of
             Nothing  -> ( exeName compCabalVersion <.> "build"
                         , appdir
                         , appdir </> exeName compCabalVersion
                         , Nothing
                         )
             Just _   -> ( distdir </> "cabal-helper"
                         , distdir
                         , distdir </> "cabal-helper" </> "cabal-helper"
                         , Just $ distdir </> "cabal-helper"
                         )

    createDirectoryIfMissing True outdir
    createDirectoryIfMissing True exedir

    withHelperSources mchsrcdir $ \compCabalHelperSourceDir -> do

    _ <- liftIO $ system $ "ls -lR " ++ compCabalHelperSourceDir

    vLog opts $ "sourcedir: " ++ compCabalHelperSourceDir
    vLog opts $ "outdir: " ++ outdir
    vLog opts $ "exe: " ++ exe

    let (mj1:mj2:mi:_) = case compCabalVersion of
                         Left _commitid -> [10000000, 0, 0]
                         Right (Version vs _) -> vs
    let ghc_opts = concat [
          [ "-outputdir", outdir<commit_msg>Remove leftover debug code<commit_after>-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015  <NAME> <dxld ÄT darkboxed DOT org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE RecordWildCards, FlexibleContexts #-}
module CabalHelper.Compiletime.Compile where

import Control.Applicative
import Control.Arrow
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Traversable
import Data.Char
import Data.List
import Data.Maybe
import Data.String
import Data.Version
import Text.Printf
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import System.IO
import System.IO.Temp
import Prelude

import Distribution.System (buildPlatform)
import Distribution.Text (display)

import Paths_cabal_helper (version)
import CabalHelper.Compiletime.Data
import CabalHelper.Compiletime.Log
import CabalHelper.Shared.Common
import CabalHelper.Shared.Sandbox (getSandboxPkgDb)
import CabalHelper.Shared.Types

data Compile = Compile {
      compCabalSourceDir :: Maybe FilePath,
      compPackageDb      :: Maybe FilePath,
      compCabalVersion   :: Either String Version,
      compPackageDeps    :: [String]
    }

compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath)
compileHelper opts cabalVer projdir distdir = do
  case cabalPkgDb opts of
    Nothing ->
      run [
            -- TODO: here ghc's caching fails and it always recompiles, probably
            -- because we write the sources to a tempdir and they always look
            -- newer than the Cabal sources, not sure if we can fix this
            compileCabalSource
          , Right <$> MaybeT (cachedExe cabalVer)
          , compileSandbox
          , compileGlobal
          , cachedCabalPkg
          , MaybeT (Just <$> compilePrivatePkgDb)
          ]
    mdb ->
      run [ Right <$> MaybeT (cachedExe cabalVer)
          , liftIO $ compileWithPkg mdb cabalVer
          ]

 where
   run actions = fromJust <$> runMaybeT (msum actions)

   logMsg = "compiling helper with Cabal from "

-- for relaxed deps: find (sameMajorVersionAs cabalVer) . reverse . sort

   -- | Check if this version is globally available
   compileGlobal :: MaybeT IO (Either ExitCode FilePath)
   compileGlobal = do
       ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts
       vLog opts $ logMsg ++ "user/global package-db"
       liftIO $ compileWithPkg Nothing ver

   -- | Check if this version is available in the project sandbox
   compileSandbox :: MaybeT IO (Either ExitCode FilePath)
   compileSandbox = do
       sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts
       ver <- MaybeT $ logSomeError opts "compileSandbox" $
         find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)
       vLog opts $ logMsg ++ "sandbox package-db"
       liftIO $ compileWithPkg (Just sandbox) ver


   -- | Check if we already compiled this version of cabal into a private
   -- package-db
   cachedCabalPkg :: MaybeT IO (Either ExitCode FilePath)
   cachedCabalPkg = do
       db_exists <- liftIO $ cabalPkgDbExists opts cabalVer
       case db_exists of
         False -> mzero
         True -> do
             db <- liftIO $ getPrivateCabalPkgDb opts (Right cabalVer)
             vLog opts $ logMsg ++ "private package-db in " ++ db
             liftIO $ compileWithPkg (Just db) cabalVer

   -- | See if we're in a cabal source tree
   compileCabalSource :: MaybeT IO (Either ExitCode FilePath)
   compileCabalSource = do
       let cabalFile = projdir </> "Cabal.cabal"
       cabalSrc <- liftIO $ doesFileExist cabalFile
       case cabalSrc of
         False -> mzero
         True -> liftIO $ do
           vLog opts $ "directory above distdir looks like cabal source tree (Cabal.cabal exists)"
           ver <- cabalFileVersion <$> readFile cabalFile
           vLog opts $ "compiling helper with local Cabal source tree"
           compileWithCabalTree ver projdir

   -- | Compile the requested cabal version into an isolated package-db
   compilePrivatePkgDb :: IO (Either ExitCode FilePath)
   compilePrivatePkgDb = do
       db <- installCabal opts cabalVer `E.catch`
             \(SomeException _) -> errorInstallCabal cabalVer distdir
       compileWithPkg (Just db) cabalVer

   compileWithCabalTree ver srcDir =
       compile distdir opts $ Compile {
                     compCabalSourceDir       = Just srcDir,
                     compPackageDb            = Nothing,
                     compCabalVersion         = Right ver,
                     compPackageDeps          = []
                   }

   compileWithPkg mdb ver =
       compile distdir opts $ Compile {
                     compCabalSourceDir       = Nothing,
                     compPackageDb            = mdb,
                     compCabalVersion         = Right ver,
                     compPackageDeps          = [cabalPkgId ver]
                   }

   cabalPkgId v = "Cabal-" ++ showVersion v

compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath)
compile distdir opts@Options {..} Compile {..} = do
    cnCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir
    appdir <- appCacheDir

    let (outdir, exedir, exe, mchsrcdir) =
          case cnCabalSourceDir of
             Nothing  -> ( exeName compCabalVersion <.> "build"
                         , appdir
                         , appdir </> exeName compCabalVersion
                         , Nothing
                         )
             Just _   -> ( distdir </> "cabal-helper"
                         , distdir
                         , distdir </> "cabal-helper" </> "cabal-helper"
                         , Just $ distdir </> "cabal-helper"
                         )

    createDirectoryIfMissing True outdir
    createDirectoryIfMissing True exedir

    withHelperSources mchsrcdir $ \compCabalHelperSourceDir -> do

    vLog opts $ "sourcedir: " ++ compCabalHelperSourceDir
    vLog opts $ "outdir: " ++ outdir
    vLog opts $ "exe: " ++ exe

    let (mj1:mj2:mi:_) = case compCabalVersion of
                         Left _commitid -> [10000000, 0, 0]
                         Right (Version vs _) -> vs
    let ghc_opts = concat [
          [ "-outputdir", outdir
{'fraction_non_alphanumeric': 0.07469501319825926, 'fraction_numerical': 0.002425626025540415, 'mean_word_length': 2.264555193292967, 'pattern_counts': {'":': 0, '<': 62, '<?xml version=': 0, '>': 75, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 2, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6795185', 'n_tokens_mistral': 4070, 'n_tokens_neox': 3875, 'n_words': 1289}