module Runner (mainRunner, runArgs, defaultPriority) where import System.Timeout import qualified Data.Map as Map import qualified Data.List as List import qualified Data.Maybe (maybe) import qualified Version import Log (msgDebug, msgInfo, msgError) import qualified Configuration import qualified Engine import qualified EngineFastpic import qualified EngineRghost import qualified EngineRadikal import qualified EngineIpicture import qualified EngineOmpldr import qualified EngineFlashtux import qualified EngineImagebin import qualified EngineImm import qualified EngineScrin import qualified EngineScrnsht import qualified EngineImgur engineConfigs = Map.fromList [ ("fastpic", (EngineFastpic.config, EngineFastpic.handler)), ("rghost", (EngineRghost.config, EngineRghost.handler)), ("ipicture", (EngineIpicture.config, EngineIpicture.handler)), ("ompldr", (EngineOmpldr.config, EngineOmpldr.handler)), ("flashtux", (EngineFlashtux.config, EngineFlashtux.handler)), ("imagebin", (EngineImagebin.config, EngineImagebin.handler)), ("radikal", (EngineRadikal.config, EngineRadikal.handler)), ("scrnsht", (EngineScrnsht.config, EngineScrnsht.handler)), ("scrin", (EngineScrin.config, EngineScrin.handler)), ("imgur", (EngineImgur.config, EngineImgur.handler)), ("imm", (EngineImm.config, EngineImm.handler))] usage :: String usage = "imp v" ++ Version.fullVersion ++ "\r\nusage: program [engine] \r\nengines: " ++ Engine.engineNames engineConfigs -- | Check the config for inappropriate values and fill them with valid ones fillConfig :: Configuration.Configuration -> Configuration.Configuration fillConfig oldConfig = oldConfig { Configuration.cfgEnginePriority = priority } where priority = if Configuration.cfgEnginePriority oldConfig == [] then Map.keys engineConfigs else Configuration.cfgEnginePriority oldConfig -- | Run engine with given name runEngine :: FilePath -> Configuration.Configuration -> String -> IO (Maybe String) runEngine filename config name = do msgDebug $ "Trying engine: " ++ show name let (state, handler) = engineConfigs Map.! name runner = Engine.runPasteHandler filename config state handler timeoutMus = Configuration.cfgNetworkTimeout config timeoutMs = timeoutMus `div` 1000 result <- timeout timeoutMus runner case result of Nothing -> do msgError $ "error: Network timeout (" ++ name ++ ", " ++ show timeoutMs ++ "ms)" return Nothing -- timeout Just x -> return x -- ok, but there might be internal errors defaultPriority :: [String] defaultPriority = Map.keys engineConfigs -- | Mixes given engine names from priorities and file type mapping. -- Names from the mapping are pushed to the head of the resulting list buildPriority :: String -> [String] -> [Configuration.FileTypeMapping] -> [String] buildPriority filename = foldl addPriority where addPriority priorities mapping = let engine = Configuration.ftmEngine mapping types = Configuration.ftmTypes mapping in if any (`List.isSuffixOf` filename) types then engine : List.delete engine priorities else priorities runArgs :: [String] -> Configuration.Configuration -> IO (Maybe String) -- | Run all available engines in an order affected by -- engine_priority and file_type_mapping properties runArgs (filename:[]) config = runEngines priorities (Configuration.cfgTryNextEngineOnError config) where configPlusDefaultPriorities = List.nub $ Configuration.cfgEnginePriority config ++ defaultPriority priorities :: [String] priorities = buildPriority filename configPlusDefaultPriorities (Configuration.cfgFileTypeMapping config) runEngines :: [String] -> Bool -> IO (Maybe String) -- We were initially given an empty list of engine names runEngines [] _ = do mapM_ msgError ["error: Cannot select engine. Possible reasons:", "- could not read any of config files", "- engine priority in config file list is empty", "- none of the file type mappings matches the filename suffix", "- missing explicit engine name in commnad-line arguments"] return Nothing runEngines (name:_) False = runEngine filename config name -- run only first engine runEngines names tryNext = runNextEngine names tryNext -- run all the engines runNextEngine :: [String] -> Bool -> IO (Maybe String) runNextEngine [] _ = return Nothing runNextEngine (name:rest) tryNext = do result <- runEngine filename config name maybe (runNextEngine rest tryNext) (return . Just) result -- | Run only specified engine and do not try others on error runArgs (engine:filename:[]) config = selectAction names where names = Map.keys engines engines = Map.filterWithKey (\k _ -> engine `List.isPrefixOf` k) engineConfigs selectAction [] = do msgError $ "error: engine not found\r\nengines: " ++ Engine.engineNames engineConfigs return Nothing selectAction [name] = runEngine filename config name selectAction _ = do msgError $ "error: ambiguous engine name. can be: " ++ Engine.engineNames engines return Nothing runArgs _ _ = msgError usage >> return Nothing mainRunner :: [String] -> IO (Maybe String) mainRunner args = do configPaths <- Configuration.configFilePaths msgDebug $ "configPaths: " ++ show configPaths -- "" will return dummy empty config if no configs will be found config <- Configuration.readConfigFiles $ configPaths ++ [""] let filledConfig = fillConfig config msgDebug "=== imp.conf ===" msgDebug $ show filledConfig runArgs args filledConfig