module UHC.Light.Compiler.EHC.Main
( mainEHC )
where
import System.Console.GetOpt
import System.IO
import System.Exit
import System.Process
import System.Environment
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.Main.Utils
import UHC.Light.Compiler.EHC.Environment
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import UHC.Light.Compiler.EHC.InitialSetup
import UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases
import qualified Debug.Trace
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State
import UHC.Light.Compiler.Base.Target
import UHC.Light.Compiler.Base.Optimize (allOptimizeMp)
import qualified UHC.Light.Compiler.SourceCodeSig as Sig
import UHC.Light.Compiler.EHC.CompilePhase.Module
import UHC.Light.Compiler.Module.ImportExport (modBuiltin)
import UHC.Light.Compiler.Module.ImportExport
import System.Directory
import UHC.Light.Compiler.Base.PackageDatabase
import UHC.Light.Compiler.Base.Parser2
import qualified UHC.Light.Compiler.ConfigCabal as Cfg (getDataDir)












{-# LINE 94 "src/ehc/EHC/Main.chs" #-}
mainEHC :: IO ()
mainEHC
  =  do  {  args      <- getArgs
         ;  progName  <- getProgName
         ;  curDir    <- getCurrentDirectory
         -- an empty data dir means we are running as cabal installed exec
         ;  mbDataDir <- Cfg.getDataDir >>= \d -> return $ if null d then Nothing else Just d
         ;  let  opts1          = defaultEHCOpts
                                    { ehcOptEnvironment     = defaultEHCEnvironment
                                    , ehcProgName           = p
                                    , ehcCurDir             = curDir
                                    }
                                where p = mkFPath "uhcl"     -- hardbaked name
                 oo@(o,n,errs)  = ehcCmdLineOptsApply (maybe [] (\d -> [\o -> o {ehcOptCfgInstallRoot = Just d}]) mbDataDir) args opts1
                 opts2          = maybe opts1 id o
         ;  case opts2 of
              o | isNotOk (ehcOptMbTarget       o) -> err $ "non existent target `"        ++ fromNotOk (ehcOptMbTarget       o) ++ "'"
                | isNotOk (ehcOptMbTargetFlavor o) -> err $ "non existent target flavor `" ++ fromNotOk (ehcOptMbTargetFlavor o) ++ "'"
                where err x
                        = do { hPutStrLn stderr ("option error: " ++ x)
                             ; exitFailure
                             }
              _ -> return ()
         ;  userDir <- ehcenvDir (envkey opts2)
         ;  let opts3 = opts2 { ehcOptUserDir = userDir
                              , ehcOptOutputDir =
                                  let outputDir = maybe "." id (ehcOptOutputDir opts2)
                                  in  case ehcOptPkgOpt opts2 of
                                        Just (PkgOption {pkgoptName=s})
                                          -> case parsePkgKey s of
                                               Just k  -> Just $
                                                          outputDir ++ "/" ++
                                                          mkInternalPkgFileBase k (Cfg.installVariant opts2)
                                                                                (ehcOptTarget opts2) (ehcOptTargetFlavor opts2)
                                               _       -> ehcOptOutputDir opts2
                                        _ -> ehcOptOutputDir opts2
                              }
         ;  case ehcOptImmQuit opts3 of
              Just immq     -> let
                                   inputSuffixes = catMaybes [ s | (s,_,vis) <- mkFileSuffMpHs opts3, vis ]
                               in  handleImmQuitOption ehcCmdLineOpts inputSuffixes immq opts3
              _ | null errs ->
                               unless (null n) (doCompileRun n opts3)
                | otherwise -> do { putStr (head errs)
                                  ; exitFailure
                                  }
         }
  where envkey opts = mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant

{-# LINE 189 "src/ehc/EHC/Main.chs" #-}
defaultEHCEnvironment :: EHCEnvironment
defaultEHCEnvironment
  = EHCEnvironment Cfg.ehcDefaultVariant Cfg.ehcDefaultInplaceInstallDir

{-# LINE 267 "src/ehc/EHC/Main.chs" #-}
doCompilePrepare :: [String] -> EHCOpts -> IO (Maybe (EHCOpts,[FPath],[HsName],EHCompileRun))
doCompilePrepare fnL@(fn:_) opts
  = do { let fpL@(fp:_)             = map (mkTopLevelFPath "hs") fnL
             topModNmL@(topModNm:_) = map (mkHNm . fpathBase) fpL
             -- installVariant         = Cfg.installVariant opts
       -- ; installRoot <- Cfg.installRootM opts
       -- ; userDir <- ehcenvDir (Cfg.verFull Cfg.version)
       -- ; let opts2 = opts -- {ehcOptUserDir = userDir}
       ; pkgDb1 <- pkgDbFromDirs opts
                    ({-
                        [ filePathCoalesceSeparator $ filePathUnPrefix
                          $ Cfg.mkDirbasedInstallPrefix (filelocDir d) Cfg.INST_LIB_PKG "" (show (ehcOptTarget opts)) ""
                        | d <- ehcOptPkgdirLocPath opts
                        ]
                     ++ [ filePathUnPrefix
                          $ Cfg.mkDirbasedTargetVariantPkgPrefix installRoot installVariant (show (ehcOptTarget opts)) ""
                        ]
                     -}
                     {-
                     -}
                        [ filePathUnPrefix d
                        | d <- nub $ ehcOptPkgdirLocPath opts ++ [Cfg.mkInstallPkgdirUser opts, Cfg.mkInstallPkgdirSystem opts]
                        ]
                    )
       ; let (pkgDb2,pkgErrs) = pkgDbSelectBySearchFilter (pkgSearchFilter Just PackageSearchFilter_ExposePkg (map tup123to1 $ pkgExposedPackages pkgDb1)
                                                           ++ sort (ehcOptPackageSearchFilter opts)
                                                          ) pkgDb1
             pkgDb3 = pkgDbFreeze pkgDb2
       -- ; putStrLn $ "db1 " ++ show pkgDb1
       -- ; putStrLn $ "db2 " ++ show pkgDb2
       -- ; putStrLn $ "db3 " ++ show pkgDb3
       -- ; putStrLn (show $ ehcOptPackageSearchFilter opts)
       ; ehcioinfo <- newEHCIOInfo
       ; let searchPath     = [emptyFileLoc]
                              ++ ehcOptImportFileLocPath opts
                              {-
                              ++ [ mkPkgFileLoc (p, Nothing) $ filePathUnPrefix
                                   $ Cfg.mkDirbasedLibVariantTargetPkgPrefix (filelocDir d) "" (show (ehcOptTarget opts)) p
                                 | d <- ehcOptLibFileLocPath opts
                                 , p <- ehcOptLibPackages opts
                                 ]
                              ++ [ mkPkgFileLoc p $ filePathUnPrefix
                                   $ Cfg.mkDirbasedTargetVariantPkgPrefix installRoot installVariant (show (ehcOptTarget opts)) p
                                 | p <- (   ehcOptLibPackages opts
                                         ++ (if ehcOptHideAllPackages opts then [] else Cfg.ehcAssumedPackages)
                                        )
                                 ]
                              -}
                              ++ [fileLocPkgDb]
             opts3          = opts { ehcOptImportFileLocPath = searchPath
                                    , ehcOptPkgDb = pkgDb3
                                    }
{- this does not work in ghc 6.8.2
             crsi           = emptyEHCompileRunStateInfo
                                { crsiOpts       =   opts3
                                , crsiHSInh      =   initialHSSem opts3
                                , crsiEHInh      =   initialEHSem opts3 fp
                                , crsiCoreInh    =   initialCore2GrSem opts3
                                -- , crsiHIInh      =   initialHISem opts3
                                , crsiHSModInh   =   initialHSSemMod opts3
                                }
-}
             crsi           =   (EHCompileRunStateInfo opts3
                                                       uidStart uidStart
                                                       (initialHSSem opts3)
                                                       (initialEHSem opts3 fp)
                                                       (initialCore2GrSem opts3)
                                                       Nothing
                                                       -- (initialHISem opts3)
                                                       (initialHSSemMod opts3)
                                                       Map.empty Map.empty defaultOptim
                                                       Map.empty
                                                       ehcioinfo []
                                )
             initialState   = mkEmptyCompileRun topModNm crsi
       ; return $ Just (opts3,fpL,topModNmL,initialState)
       }

doCompileRun :: [String] -> EHCOpts -> IO ()
doCompileRun fnL@(fn:_) opts
  = do { mbPrep <- doCompilePrepare fnL opts
       ; if isJust mbPrep
         then do { let ( opts
                        , fpL@(fp:_)
                        , topModNmL@(topModNm:_)
                        , initialState
                        ) = fromJust mbPrep
                       searchPath = ehcOptImportFileLocPath opts
                       fileSuffMpHs = mkFileSuffMpHs opts
                 ; when (ehcOptVerbosity opts >= VerboseDebug)
                        (putStrLn $ "search path: " ++ show searchPath)
                 ; _ <- if False -- ehcOptPriv opts
                        then runStateT (compile2 opts fileSuffMpHs searchPath fpL topModNmL) initialState
                        else runStateT (compile  opts fileSuffMpHs searchPath fpL topModNmL) initialState
                 ; return ()
                 }
         else exitFailure
       }
  where compile2 :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase ()
        compile2 opts fileSuffMpHs searchPath fpL topModNmL
          = do {
               -- start with directly importing top modules, providing the filepath directly
                 topModNmL' <- toplayer fpL topModNmL
               ; cpPP "topModNmL'"
               ; oneModNmL <- onelayer
               ; cpPP "oneModNmL"
               ; return ()
               }
          where toplayer fpL topModNmL
                  = zipWithM (\fp topModNm -> imp1 opts fileSuffMpHs searchPath (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL
                onelayer
                  = do { cr <- get
                       ; let modNmS = Map.keysSet $ crCUCache cr
                             ms = Set.unions
                                    [ case cuState e of
                                        -- ECUS_Haskell HIOnlyImports -> ecuTransClosedOrphanModS ecu
                                        _                         -> ecuImpNmS e
                                    | m <- Set.toList modNmS, let e = crCU m cr
                                    ]
                                  `Set.difference` modNmS
                       ; sequence -- or: cpSeq + return ()
                           [ do { i@(m',_) <- imp1 opts fileSuffMpHs searchPath (ECUS_Haskell HSOnlyImports) Nothing Nothing m
                                -- ; cpEhcFullProgModuleDetermineNeedsCompile m'
                                ; return i
                                }
                           | m <- Set.toList ms
                           ]
                       }

                -- dbg
                {-
                showCompileOrder
                  = do { cr <- get
                       ; lift $ putStrLn $ "compile order: " ++ show (crCompileOrder cr)
                       }
                -}

        compile :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase ()
        compile opts fileSuffMpHs searchPath fpL topModNmL@(modNm:_)
          = do { cpMsg modNm VerboseDebug $ "doCompileRun.compile topModNmL: " ++ show topModNmL

               -- check module import relationship for builtin module
               ; cpCheckModsModWith (const emptyModMpInfo) [modBuiltin]

               -- start with directly importing top modules, providing the filepath directly
               ; topModNmL' <- zipWithM (\fp topModNm -> imp (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL

               -- follow the import relation to chase modules which have to be analysed
               ; cpImportGatherFromModsWithImp
                   (if ehcOptPriv opts
                    then \ecu -> case ecuState ecu of
                                   -- ECUS_Haskell HIStart -> Set.toList $ ecuTransClosedOrphanModS ecu
                                   ECUS_Haskell HIOnlyImports -> [] -- Set.toList $ ecuTransClosedOrphanModS ecu
                                   _ -> ecuImpNmL ecu
                    else ecuImpNmL
                   )
                   (imp (ECUS_Haskell HSOnlyImports) Nothing) (map fst topModNmL')

               -- import orphans
               ; when (ehcOptPriv opts)
                      (do {
                          -- import orphans
                            importAlso (ECUS_Haskell HSOnlyImports) ecuTransClosedOrphanModS

                          -- import used remaining modules, but just minimally
                          ; importAlso (ECUS_Haskell HMOnlyMinimal) (Set.unions . Map.elems . ecuTransClosedUsedModMp)
                          })

               -- inhibit mutual recursiveness
               ; cpEhcCheckAbsenceOfMutRecModules

               -- and compile it all
               ; cpEhcFullProgCompileAllModules
               -- cleanup
               ; unless (ehcOptKeepIntermediateFiles opts) cpRmFilesToRm
               }
          where -- abbrev for imp1
                imp = imp1 opts fileSuffMpHs searchPath

                -- import others, but then in a (slightly) different way
                importAlso :: EHCompileUnitState -> (EHCompileUnit -> Set.Set HsName) -> EHCompilePhase ()
                importAlso how getNms
                  = do { cr <- get
                       ; let allAnalysedModS = Map.keysSet $ crCUCache cr
                             allNewS         = Set.unions [ getNms $ crCU m cr | m <- Set.toList allAnalysedModS ] `Set.difference` allAnalysedModS
                       ; cpImportGatherFromModsWithImp
                           (const [])
                           (imp how Nothing) (Set.toList allNewS)
                       }

        imp1 :: EHCOpts -> FileSuffMp -> FileLocPath -> EHCompileUnitState -> Maybe FPath -> Maybe (HsName,(FPath,FileLoc)) -> HsName -> EHCompilePhase (HsName,Maybe (HsName,(FPath,FileLoc)))
        imp1 opts fileSuffMpHs searchPath desiredState mbFp mbPrev nm
          = do { let isTopModule = isJust mbFp
                     fileSuffMpHs' = map tup123to12 $ (if isTopModule then fileSuffMpHsNoSuff else []) ++ fileSuffMpHs
               ; let searchPath' = adaptedSearchPath mbPrev
               ; fpsFound <- cpFindFilesForFPathInLocations (fileLocSearch opts) (\(x,_,_) -> x) False fileSuffMpHs' searchPath' (Just nm) mbFp
               ; when (ehcOptVerbosity opts >= VerboseDebug)
                      (do { lift $ putStrLn $ show nm ++ ": " ++ show (fmap fpathToStr mbFp) ++ ": " ++ show (map fpathToStr fpsFound)
                          ; lift $ putStrLn $ "searchPath: " ++ show searchPath'
                          })
               ; when isTopModule
                      (cpUpdCU nm (ecuSetIsTopMod True))
               ; cpUpdCU nm (ecuSetTarget (ehcOptTarget opts))
               ; case fpsFound of
                   (fp:_)
                     -> do { nm' <- cpEhcModuleCompile1 (Just desiredState) nm
                           ; cr <- get
                           ; let (ecu,_,_,_) = crBaseInfo nm' cr
                           ; return (nm',Just (nm',(fp, ecuFileLocation ecu)))
                           }
                   _ -> return (nm,Nothing)
               }
          where -- strip tail part corresponding to module name, and use it to search as well
                adaptedSearchPath (Just (prevNm,(prevFp,prevLoc)))
                  = case (fpathMbDir (mkFPath prevNm), fpathMbDir prevFp, prevLoc) of
                      (_, _, p) | filelocIsPkg p
                        -> p : searchPath
                      (Just n, Just p, _)
                        -> mkDirFileLoc (filePathUnPrefix prefix) : searchPath
                        where (prefix,_) = splitAt (length p - length n) p
                      _ -> searchPath
                adaptedSearchPath _ = searchPath