{-# LANGUAGE TemplateHaskell #-}

module UHC.Light.Compiler.EHC.CompileRun
( module UHC.Light.Compiler.EHC.CompileRun.Base
, cpUpdOpts
, cpStopAt
, crPartitionMainAndImported
, crModNeedsCompile
, crSetAndCheckMain
, cpGetMetaInfo
, newEHCIOInfo )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State hiding (get)
import qualified Control.Monad.State as MS
import UHC.Util.Lens
import UHC.Light.Compiler.CodeGen.ValAccess as VA
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.FileSuffMp
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun.Base
import qualified UHC.Light.Compiler.Core as Core
import qualified UHC.Light.Compiler.CoreRun as CoreRun
import qualified UHC.Light.Compiler.EH.Main as EHSem
import qualified UHC.Light.Compiler.HS.MainAG as HSSem
import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.EHC.CompileGroup
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import UHC.Light.Compiler.Module.ImportExport
import UHC.Util.Time
import System.CPUTime
import System.Locale
import Data.IORef
import System.IO.Unsafe
import System.Directory
import UHC.Util.FPath
import UHC.Light.Compiler.Base.PackageDatabase















{-# LINE 88 "src/ehc/EHC/CompileRun.chs" #-}
newEHCIOInfo :: IO (IORef EHCIOInfo)
newEHCIOInfo
  = do t <- getEHCTime
       newIORef (EHCIOInfo t t)


{-# LINE 120 "src/ehc/EHC/CompileRun.chs" #-}
cpUpdOpts :: EHCCompileRunner m => (EHCOpts -> EHCOpts) -> EHCompilePhaseT m ()
cpUpdOpts upd
  = cpUpdSI $ crsiOpts ^$= upd -- (\crsi -> crsi {crsiOpts = upd $ crsiOpts crsi})

{-# LINE 130 "src/ehc/EHC/CompileRun.chs" #-}
cpStopAt :: EHCCompileRunner m => CompilePoint -> EHCompilePhaseT m ()
cpStopAt atPhase
  = do { cr <- MS.get
       ; let (_,opts) = crBaseInfo' cr
       ; unless (atPhase < ehcStopAtPoint opts)
                cpSetStopAllSeq
       }

{-# LINE 144 "src/ehc/EHC/CompileRun.chs" #-}
crPartitionNewerOlderImports :: HsName -> EHCompileRun m -> ([EHCompileUnit],[EHCompileUnit])
crPartitionNewerOlderImports modNm cr
  = partition isNewer $ map (flip crCU cr) $ ecuImpNmL ecu
  where ecu = crCU modNm cr
        t   = panicJust "crPartitionNewerOlderImports1" $ _ecuMbHIInfoTime ecu
        isNewer ecu'
            | isJust mbt = t' `diffClockTimes` t > noTimeDiff
            | otherwise  = False
            where t' = panicJust "crPartitionNewerOlderImports2" $ _ecuMbHIInfoTime ecu'
                  mbt = _ecuMbHIInfoTime ecu'

{-# LINE 161 "src/ehc/EHC/CompileRun.chs" #-}
-- | Partition modules into main and non main (i.e. imported) module names
crPartitionMainAndImported :: EHCompileRun m -> [HsName] -> ([HsName], [HsName])
crPartitionMainAndImported cr modNmL = partition (\n -> ecuHasMain $ crCU n cr) modNmL

{-# LINE 171 "src/ehc/EHC/CompileRun.chs" #-}
crModNeedsCompile :: HsName -> EHCompileRun m -> Bool
crModNeedsCompile modNm cr
  = ecuIsMainMod ecu -- ecuIsTopMod ecu
    || not (  ehcOptCheckRecompile opts
           && ecuCanUseHIInsteadOfHS ecu
           && null newer
           )
  where ecu = crCU modNm cr
        (newer,_) = crPartitionNewerOlderImports modNm cr
        opts = _crStateInfo cr ^. crsiOpts

{-# LINE 203 "src/ehc/EHC/CompileRun.chs" #-}
crSetAndCheckMain :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
crSetAndCheckMain modNm
  = do { cr <- MS.get
       ; let (crsi,opts) = crBaseInfo' cr
             mkerr lim ns = cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MayOnlyHaveNrMain lim ns modNm]
       ; case crsiMbMainNm crsi of
           Just n | n /= modNm          -> mkerr 1 [n]
           _ | ehcOptDoExecLinking opts -> cpUpdSI (\crsi -> crsi {crsiMbMainNm = Just modNm})
             | otherwise                -> return ()
                                           -- mkerr 0 []
       }

{-# LINE 221 "src/ehc/EHC/CompileRun.chs" #-}
-- | Extract various pieces of meta info (such as timestamps) of files needed further in the compilation process
cpGetMetaInfo :: EHCCompileRunner m => [GetMeta] -> HsName -> EHCompilePhaseT m ()
cpGetMetaInfo gm modNm
  =  do  {  cr <- MS.get
         ;  let (ecu,_,opts,fp) = crBaseInfo modNm cr
         ;  when (GetMeta_Src `elem` gm) $
                 tm opts ecu ecuStoreSrcTime        (ecuSrcFilePath ecu)
                 -- void $ bcall $ ModfTimeOfFile (mkPrevFileSearchKeyWithName modNm) ASTType_HS (_ecuASTFileContent ecu, ASTFileUse_Src) ASTFileTiming_Current

         ;  when (GetMeta_HI `elem` gm)
                 (tm opts ecu ecuStoreHIInfoTime
                                              (mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi")
                 )
         ;  when (GetMeta_Core `elem` gm) $
                 tm opts ecu ecuStoreCoreTime      (fpathSetSuff Cfg.suffixDotlessBinaryCore fp)
                 -- dfltPrev ASTType_Core modNm ecu
         ;  when (GetMeta_CoreRun `elem` gm) $
                 tm opts ecu ecuStoreCoreRunTime   (fpathSetSuff Cfg.suffixDotlessBinaryCoreRun fp)
                 -- dfltPrev ASTType_CoreRun modNm ecu
         ;  when (GetMeta_Dir `elem` gm) $
                 wr opts ecu ecuStoreDirIsWritable fp
                 -- void $ bcall $ DirOfModIsWriteable modNm
         }
  where -- dfltPrev astty modNm ecu = void $ bcall $ ModfTimeOfFile (mkPrevFileSearchKeyWithName modNm) astty (ASTFileContent_Binary, ASTFileUse_Cache) ASTFileTiming_Prev

        tm :: EHCCompileRunner m => EHCOpts -> EHCompileUnit -> (ClockTime -> EHCompileUnit -> EHCompileUnit) -> FPath -> EHCompilePhaseT m ()
        tm opts ecu store fp
          = do { let n = fpathToStr fp
               ; nExists <- liftIO $ doesFileExist n
               ; when (ehcOptVerbosity opts >= VerboseDebug)
                      (do { liftIO $ putStrLn ("meta info of: " ++ show (ecuModNm ecu) ++ ", file: " ++ n ++ ", exists: " ++ show nExists)
                          })
               ; when nExists
                      (do { t <- liftIO $ fpathGetModificationTime fp
                          ; when (ehcOptVerbosity opts >= VerboseDebug)
                                 (do { liftIO $ putStrLn ("time stamp of: " ++ show (ecuModNm ecu) ++ ", time: " ++ show t)
                                     })
                          ; cpUpdCU modNm $ store t
                          })
               }
        wr opts ecu store fp
          = do { pm <- liftIO $ getPermissions (maybe "." id $ fpathMbDir fp)
               -- ; liftIO $ putStrLn (fpathToStr fp ++ " writ " ++ show (writable pm))
               ; cpUpdCU modNm $ store (writable pm)
               }