imagepaste-0.2.0.0: src/Runner.hs

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] <image-file>\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