uhc-light-1.1.8.2: src/UHC/Light/Compiler/EHC/Main/Utils.hs

module UHC.Light.Compiler.EHC.Main.Utils
( module UHC.Light.Compiler.Opts
, handleImmQuitOption
, FileSuffMp, mkFileSuffMpHs, fileSuffMpHsNoSuff )
where
import UHC.Light.Compiler.EHC.Common
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.Opts
import System.Console.GetOpt
import System.Environment
import UHC.Light.Compiler.Base.Target
import UHC.Light.Compiler.Base.Optimize (allOptimizeMp)
import qualified UHC.Light.Compiler.SourceCodeSig as Sig




{-# LINE 34 "src/ehc/EHC/Main/Utils.chs" #-}
-- | Handle a commandline option directly
handleImmQuitOption :: GetOptCmdLineOpts -> [String] -> ImmediateQuitOption -> EHCOpts -> IO ()
handleImmQuitOption cmdLineOpts inputSuffixes immq opts
  = case immq of
      ImmediateQuitOption_Help
        -> do {
                let progName = fpathToStr (ehcProgName opts)
              ; putStrLn (usageInfo (  "version: " ++ Cfg.verInfo Cfg.version ++ ", aspects: " ++ ehcOptAspects opts
                                    ++ "\n\nUsage: " ++ progName ++ " [options] [file[" ++ (concat $ intersperse "|" $ map ('.':) inputSuffixes) ++ "] ...]\n\noptions:"
                                    )
                                    cmdLineOpts)
              }
      ImmediateQuitOption_Version
        -> putStrLn $ Cfg.verInfo Cfg.version
                      ++ ", timestamp " ++ Sig.timestamp
      ImmediateQuitOption_Meta_Variant
        -> putStrLn Cfg.ehcDefaultVariant
      ImmediateQuitOption_Meta_Targets
        -> putStr showSupportedTargets
      ImmediateQuitOption_Meta_TargetDefault
        -> putStr (show defaultTarget)
      ImmediateQuitOption_Meta_Optimizations
        -> putStr (showStringMapKeys allOptimizeMp " ")
      ImmediateQuitOption_VersionDotted
        -> putStrLn (Cfg.verFull Cfg.version)
      ImmediateQuitOption_VersionAsNumber
        -> putStrLn (Cfg.verAsNumber Cfg.version)
{-
      ImmediateQuitOption_Meta_ExportEnv mvEnvOpt
        -> exportEHCEnvironment
             (mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant)
             (env {ehcenvInstallRoot = installRootDir, ehcenvVariant = variant})
        where env = ehcOptEnvironment opts
              (installRootDir,variant)
                = case fmap (wordsBy (`elem` ",;")) mvEnvOpt of
                    Just (d:v:_) -> (d,v)
                    Just (d:_)   -> (d,ehcenvVariant env)
                    _            -> (ehcenvInstallRoot env,ehcenvVariant env)
      ImmediateQuitOption_Meta_DirEnv
        -> do { d <- ehcenvDir (mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant)
              ; putStrLn d
              }
-}
      ImmediateQuitOption_Meta_Pkgdir_System
        -> do { let d = Cfg.mkInstallPkgdirSystem opts
              ; putStrLn d
              }
      ImmediateQuitOption_Meta_Pkgdir_User
        -> do { let d = Cfg.mkInstallPkgdirUser opts
              ; putStrLn d
              }

{-# LINE 107 "src/ehc/EHC/Main/Utils.chs" #-}
type FileSuffMp =
  [( FileSuffix				-- suffix
   , EHCompileUnitState		-- initial state
   , Bool					-- visible from commandline
   )]

-- | Allowed suffixes, order is significant.
mkFileSuffMpHs :: EHCOpts -> FileSuffMp
mkFileSuffMpHs opts
  = [ ( Just "hs"  , ECUS_Haskell HSStart, True )
    , ( Just "lhs" , ECUS_Haskell LHSStart, True )
    , ( Just "eh"  , ECUS_Eh EHStart, True )
    , ( Just "hi"  , ECUS_Haskell HIStart, False )
    , ( Just Cfg.suffixDotlessInputOutputTextualCore, ECUS_Core CRStartText, True   )
    , ( Just Cfg.suffixDotlessInputOutputBinaryCore , ECUS_Core CRStartBinary, True )
    , ( Just Cfg.suffixDotlessBinaryCore , ECUS_Core CRStartBinary, False )
    ]
    ++ (if targetIsOnUnixAndOrC (ehcOptTarget opts)
        then [ ( Just "c"   , ECUS_C CStart, True )
             , ( Just "o"   , ECUS_O OStart, True )
             ]
        else []
       )

{-# LINE 147 "src/ehc/EHC/Main/Utils.chs" #-}
-- Suffix map for empty suffix, defaults to .hs
fileSuffMpHsNoSuff :: FileSuffMp
fileSuffMpHsNoSuff
  = [ ( Nothing  , ECUS_Haskell HSStart, False )
    ]