module Vimeta.UI.CommandLine.Config
( Options,
optionsParser,
run,
)
where
import qualified Byline.Exit as B
import Options.Applicative
import Vimeta.Core
data Options = Options
{ Options -> Maybe Text
optsKey :: Maybe Text,
Options -> Tagger
optsTagger :: Tagger
}
optionsParser :: Parser Options
optionsParser :: Parser Options
optionsParser =
Maybe Text -> Tagger -> Options
Options
(Maybe Text -> Tagger -> Options)
-> Parser (Maybe Text) -> Parser (Tagger -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
[Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
[ Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'k',
String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"key",
String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"KEY",
String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Set the API key to KEY"
]
)
Parser (Tagger -> Options) -> Parser Tagger -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tagger -> Parser Tagger
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tagger
AtomicParsley
run :: Options -> IO ()
run :: Options -> IO ()
run Options
opts = do
let def :: Config
def = Tagger -> Config
defaultConfig (Options -> Tagger
optsTagger Options
opts)
config :: Config
config = case Options -> Maybe Text
optsKey Options
opts of
Maybe Text
Nothing -> Config
def
Just Text
k -> Config
def {configTMDBKey :: Text
configTMDBKey = Text
k}
Either String (Maybe String)
result <- ExceptT String IO (Maybe String)
-> IO (Either String (Maybe String))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Options -> Config -> ExceptT String IO (Maybe String)
app Options
opts Config
config)
case Either String (Maybe 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 (Just String
msg) -> Stylized Text -> IO ()
forall (m :: * -> *) a. (MonadIO m, ToStylizedText a) => a -> m ()
B.warn (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
msg)
Right Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
app :: Options -> Config -> ExceptT String IO (Maybe String)
app :: Options -> Config -> ExceptT String IO (Maybe String)
app Options
opts Config
config = do
String
filename <- Config -> ExceptT String IO String
forall (m :: * -> *).
MonadIO m =>
Config -> ExceptT String m String
writeConfig Config
config
Maybe String -> ExceptT String IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> ExceptT String IO (Maybe String))
-> Maybe String -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case Options -> Maybe Text
optsKey Options
opts of
Just Text
_ -> Maybe String
forall a. Maybe a
Nothing
Maybe Text
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
missingKey String
filename)
where
missingKey :: String -> String
missingKey = (String
"please edit the config file and set the API key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)