-- |
--
-- Copyright:
--   This file is part of the package vimeta. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/vimeta
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: BSD-2-Clause
--
-- | Common types/functions used in the command line interface.
module Vimeta.UI.CommandLine.Common
  ( CommonOptions,
    commonOptions,
    updateConfig,
  )
where

import Options.Applicative
import Vimeta.Core

-- | Common command line options among all of the apps.
data CommonOptions = CommonOptions
  { CommonOptions -> Bool
optsVerbose :: Bool,
    CommonOptions -> Bool
optsDryRun :: Bool
  }

-- | Common option parser.
commonOptions :: Parser CommonOptions
commonOptions :: Parser CommonOptions
commonOptions =
  Bool -> Bool -> CommonOptions
CommonOptions (Bool -> Bool -> CommonOptions)
-> Parser Bool -> Parser (Bool -> CommonOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch Mod FlagFields Bool
forall a. Mod FlagFields a
infoVerbose
    Parser (Bool -> CommonOptions)
-> Parser Bool -> Parser CommonOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch Mod FlagFields Bool
forall a. Mod FlagFields a
infoDryRun
  where
    infoVerbose :: Mod FlagFields a
infoVerbose = String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
help String
"Enable verbose output"
    infoDryRun :: Mod FlagFields a
infoDryRun =
      Char -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd' Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dry-run"
        Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't tag files, implies --verbose"

-- | Update the configuration file base on the common command line options.
updateConfig :: CommonOptions -> Config -> Config
updateConfig :: CommonOptions -> Config -> Config
updateConfig CommonOptions
o Config
c =
  Config
c
    { configVerbose :: Bool
configVerbose = Config -> Bool
configVerbose Config
c Bool -> Bool -> Bool
|| CommonOptions -> Bool
optsVerbose CommonOptions
o,
      configDryRun :: Bool
configDryRun = Config -> Bool
configDryRun Config
c Bool -> Bool -> Bool
|| CommonOptions -> Bool
optsDryRun CommonOptions
o
    }