imagepaste / src / Runner.hs

Full commit
module Runner (mainRunner,
               defaultPriority) where

import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Maybe (maybe)

import qualified Version
import Log (msgDebug, msgInfo)

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
  let (state, handler) = (engineConfigs Map.! name)
  msgDebug $ "Trying engine: " ++ show name
  Engine.runPasteHandler filename config state handler

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 priorities mappings = foldl addPriority priorities mappings where
  addPriority prs mapping =
    let engine = Configuration.ftmEngine mapping
        types = Configuration.ftmTypes mapping
    in if any (flip List.isSuffixOf $ filename) types
       then engine:(List.delete engine prs)
       else prs

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_ msgInfo ["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
    msgInfo $ "error: engine not found\r\nengines: " ++ Engine.engineNames engineConfigs
    return Nothing
  selectAction [name] = runEngine filename config name
  selectAction _      = do
    msgInfo $ "error: ambiguous engine name. can be: " ++ Engine.engineNames engines
    return Nothing

runArgs _ _ = msgInfo 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