module Imm.Boot (imm, ConfigFeed) where
import qualified Imm.Core as Core
import Imm.Config
import Imm.Database
import Imm.Dyre as Dyre
import Imm.Error
import Imm.Options (Action(..), Configuration(..), OptionsReader(..))
import qualified Imm.Options as Options
import Imm.Util
import Control.Lens hiding (Action, (??))
import Control.Monad.Error hiding(when)
import Control.Monad.Reader hiding(when)
import Data.Version
import Network.URI as N
import Paths_imm
import System.Log.Logger
import System.Exit
type ConfigFeed = (Config -> Config, String)
imm :: [ConfigFeed] -> IO ()
imm feedsFromConfig = Options.run $ do
action <- readOptions Options.action
configuration <- readOptions Options.configuration
feedsFromOptions <- readOptions Options.feedsList
dataDir <- readOptions Options.dataDirectory
when (action == Help) . io $ putStrLn Options.usage >> exitSuccess
when (action == ShowVersion) . io $ putStrLn (showVersion version) >> exitSuccess
when (action == Recompile) . io $ Dyre.recompile >>= maybe exitSuccess (\e -> putStrLn e >> exitFailure)
io $ Dyre.wrap (configuration == Vanilla) realMain (action, dataDir, feedsFromOptions, feedsFromConfig)
validateFeeds :: [ConfigFeed] -> [URI] -> ([String], Core.FeedList)
validateFeeds feedsFromConfig feedsFromOptions = (errors ++ errors', null feedsFromOptions ? feedsOK ?? feedsOK')
where
validateFromConfig (x, u) = maybe (Left ("Invalid feed URI: " ++ u)) (Right . (x,)) $ N.parseURI u
validateFromOptions uri = maybe (Left ("URI from commandline option has no configuration entry: " ++ show uri)) Right . listToMaybe . filter ((== uri) . snd) $ feedsOK
(errors, feedsOK) = partitionEithers $ map validateFromConfig feedsFromConfig
(errors', feedsOK') = partitionEithers $ map validateFromOptions feedsFromOptions
realMain :: (Action, Maybe FilePath, [URI], [ConfigFeed]) -> IO ()
realMain (action, dataDir, feedsFromOptions, feedsFromConfig) = do
let (errors, feedsOK) = validateFeeds feedsFromConfig feedsFromOptions
unless (null errors) . errorM "imm.boot" $ unlines errors
when (null feedsOK) $ warningM "imm.boot" "Nothing to process. Exiting..." >> exitFailure
withError . withConfig (maybe id (set (fileDatabase . directory)) dataDir) $ dispatch action feedsOK
dispatch :: Action -> Core.FeedList -> ReaderT Config (ErrorT ImmError IO) ()
dispatch CheckFeeds feeds = mapM_ Core.check feeds
dispatch ListFeeds feeds = mapM_ Core.list feeds
dispatch MarkAsRead feeds = mapM_ Core.markAsRead feeds
dispatch MarkAsUnread feeds = mapM_ Core.markAsUnread feeds
dispatch UpdateFeeds feeds = mapM_ Core.update feeds
dispatch ImportFeeds _ = Core.importOPML =<< io getContents
dispatch _ _ = io $ putStrLn Options.usage