module Vimeta.Core.Config
( Config (..),
defaultConfig,
configFileName,
readConfig,
writeConfig,
)
where
import Control.Monad.Except
import Data.Aeson hiding (encodeFile)
import Data.Aeson.Types (typeMismatch)
import Data.Yaml (decodeFileEither, encodeFile)
import Network.API.TheMovieDB (Key)
import System.Directory
( XdgDirectory (XdgConfig),
createDirectoryIfMissing,
doesFileExist,
getXdgDirectory,
)
import System.FilePath (takeDirectory, (</>))
import Vimeta.Core.Tagger
data Config = Config
{ Config -> Key
configTMDBKey :: Key,
Config -> Key
configFormatMovie :: Text,
Config -> Key
configFormatTV :: Text,
Config -> Bool
configVerbose :: Bool,
Config -> Bool
configDryRun :: Bool
}
instance FromJSON Config where
parseJSON :: Value -> Parser Config
parseJSON (Object Object
v) =
Key -> Key -> Key -> Bool -> Bool -> Config
Config (Key -> Key -> Key -> Bool -> Bool -> Config)
-> Parser Key -> Parser (Key -> Key -> Bool -> Bool -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tmdb_key"
Parser (Key -> Key -> Bool -> Bool -> Config)
-> Parser Key -> Parser (Key -> Bool -> Bool -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cmd_movie"
Parser (Key -> Bool -> Bool -> Config)
-> Parser Key -> Parser (Bool -> Bool -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cmd_tv"
Parser (Bool -> Bool -> Config)
-> Parser Bool -> Parser (Bool -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verbose" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
Parser (Bool -> Config) -> Parser Bool -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dryrun" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
parseJSON Value
x = String -> Value -> Parser Config
forall a. String -> Value -> Parser a
typeMismatch String
"configuration" Value
x
instance ToJSON Config where
toJSON :: Config -> Value
toJSON Config
c =
[Pair] -> Value
object
[ Key
"tmdb_key" Key -> Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Config -> Key
configTMDBKey Config
c,
Key
"cmd_movie" Key -> Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Config -> Key
configFormatMovie Config
c,
Key
"cmd_tv" Key -> Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Config -> Key
configFormatTV Config
c
]
defaultConfig :: Tagger -> Config
defaultConfig :: Tagger -> Config
defaultConfig Tagger
tagger =
Config :: Key -> Key -> Key -> Bool -> Bool -> Config
Config
{ configTMDBKey :: Key
configTMDBKey = Key
"your API key goes here",
configFormatMovie :: Key
configFormatMovie = Key
fmtMovie,
configFormatTV :: Key
configFormatTV = Key
fmtTV,
configVerbose :: Bool
configVerbose = Bool
False,
configDryRun :: Bool
configDryRun = Bool
False
}
where
(Key
fmtMovie, Key
fmtTV) = Tagger -> (Key, Key)
formatStringsForTagger Tagger
tagger
configFileName :: IO FilePath
configFileName :: IO String
configFileName =
XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"vimeta"
IO String -> (String -> String) -> IO String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> String
</> String
"config.yml")
readConfig :: (MonadIO m) => ExceptT String m Config
readConfig :: ExceptT String m Config
readConfig = do
String
filename <- IO String -> ExceptT String m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
configFileName
Bool
exists <- IO Bool -> ExceptT String m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Bool
doesFileExist String
filename)
if Bool
exists
then String -> ExceptT String m Config
forall (m :: * -> *).
MonadIO m =>
String -> ExceptT String m Config
decodeConfig String
filename
else String -> ExceptT String m Config
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String m Config)
-> String -> ExceptT String m Config
forall a b. (a -> b) -> a -> b
$ String -> String
missingFile String
filename
where
decodeConfig :: (MonadIO m) => FilePath -> ExceptT String m Config
decodeConfig :: String -> ExceptT String m Config
decodeConfig String
fn = do
Either ParseException Config
result <- IO (Either ParseException Config)
-> ExceptT String m (Either ParseException Config)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException Config)
-> ExceptT String m (Either ParseException Config))
-> IO (Either ParseException Config)
-> ExceptT String m (Either ParseException Config)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either ParseException Config)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fn
case Either ParseException Config
result of
Left ParseException
e -> String -> ExceptT String m Config
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParseException -> String
forall b a. (Show a, IsString b) => a -> b
show ParseException
e)
Right Config
a -> Config -> ExceptT String m Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
a
missingFile :: FilePath -> String
missingFile :: String -> String
missingFile String
fn =
String
"no config file found, use the `config' command "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"to create "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn
writeConfig :: (MonadIO m) => Config -> ExceptT String m FilePath
writeConfig :: Config -> ExceptT String m String
writeConfig Config
c = do
(String
filename, Bool
exists) <- IO (String, Bool) -> ExceptT String m (String, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, Bool) -> ExceptT String m (String, Bool))
-> IO (String, Bool) -> ExceptT String m (String, Bool)
forall a b. (a -> b) -> a -> b
$ do
String
fn <- IO String
configFileName
Bool
ex <- String -> IO Bool
doesFileExist String
fn
(String, Bool) -> IO (String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fn, Bool
ex)
Bool -> ExceptT String m () -> ExceptT String m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (ExceptT String m () -> ExceptT String m ())
-> ExceptT String m () -> ExceptT String m ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> String
existError String
filename)
IO () -> ExceptT String m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
filename))
IO () -> ExceptT String m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Config -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile String
filename Config
c)
String -> ExceptT String m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filename
where
existError :: FilePath -> String
existError :: String -> String
existError String
fn = String
"please remove the existing config file first: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn