{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

module Vimeta.UI.CommandLine (run) where

import qualified Byline.Exit as B
import Data.Version (showVersion)
import Options.Applicative
import Paths_vimeta (version)
import qualified Vimeta.UI.CommandLine.Config as Config
import qualified Vimeta.UI.CommandLine.Movie as Movie
import qualified Vimeta.UI.CommandLine.TV as TV

data Command
  = CmdVersion
  | CmdConfig Config.Options
  | CmdMovie Movie.Options
  | CmdTV TV.Options

optionsParser :: Parser Command
optionsParser :: Parser Command
optionsParser = Parser Command
verbose Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
commands
  where
    verbose :: Parser Command
verbose =
      Command -> Mod FlagFields Command -> Parser Command
forall a. a -> Mod FlagFields a -> Parser a
flag'
        Command
CmdVersion
        (String -> Mod FlagFields Command
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod FlagFields Command
-> Mod FlagFields Command -> Mod FlagFields Command
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Command
forall (f :: * -> *) a. String -> Mod f a
help String
"Print version and exit")
    commands :: Parser Command
commands =
      Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat [Mod CommandFields Command
config, Mod CommandFields Command
movie, Mod CommandFields Command
tv]
    subcommand :: String -> String -> Parser a -> Mod CommandFields a
subcommand String
name String
desc Parser a
parser =
      String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
name (Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser a
parser Parser a -> Parser (a -> a) -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (a -> a)
forall a. Parser (a -> a)
helper) (String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
desc))
    config :: Mod CommandFields Command
config =
      String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
subcommand String
"config" String
configDesc (Options -> Command
CmdConfig (Options -> Command) -> Parser Options -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
Config.optionsParser)
    movie :: Mod CommandFields Command
movie =
      String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
subcommand String
"movie" String
movieDesc (Options -> Command
CmdMovie (Options -> Command) -> Parser Options -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
Movie.optionsParser)
    tv :: Mod CommandFields Command
tv =
      String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
subcommand String
"tv" String
tvDesc (Options -> Command
CmdTV (Options -> Command) -> Parser Options -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
TV.optionsParser)
    configDesc :: String
configDesc =
      String
"Create a new configuration file"
    movieDesc :: String
movieDesc =
      String
"Tag a movie file using data from TheMovieDB.org"
    tvDesc :: String
tvDesc =
      String
"Tag episode files using data from TheMovieDB.org"

run :: IO ()
run :: IO ()
run = do
  Command
options <- ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser (ParserInfo Command -> IO Command)
-> ParserInfo Command -> IO Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
optionsParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper) InfoMod Command
forall m. Monoid m => m
idm

  Either String ()
result <- case Command
options of
    Command
CmdVersion -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Version -> String
showVersion Version
version) IO () -> Either String () -> IO (Either String ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> () -> Either String ()
forall a b. b -> Either a b
Right ()
    CmdConfig Options
o -> Options -> IO ()
Config.run Options
o IO () -> Either String () -> IO (Either String ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> () -> Either String ()
forall a b. b -> Either a b
Right ()
    CmdMovie Options
o -> Options -> IO (Either String ())
Movie.run Options
o
    CmdTV Options
o -> Options -> IO (Either String ())
TV.run Options
o

  case Either String ()
result of
    Left String
e -> Stylized Text -> IO ()
forall (m :: * -> *) a b. (MonadIO m, ToStylizedText a) => a -> m b
B.die (Text -> Stylized Text
B.text (Text -> Stylized Text) -> Text -> Stylized Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
e)
    Right () -> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess