{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Option
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Command-line options

module Yi.Option
    (
    -- * Types
      YiOption
    , YiOptionDescr
    , YiOptions
    , OptionError(..)

    -- * Core
    , yiCustomOptions
    , consYiOption
    , consYiOptions

    -- * Argument-less options
    , yiBoolOption
    , yiFlagOption
    , yiActionFlagOption

    -- * Argument-taking options
    , yiStringOption
    , yiStringOption'
    , yiActionOption
    , yiActionOption'
    )
where

import           Data.Default          (Default)
import qualified Data.Text             as T (Text)
import           Data.Typeable         (Typeable)
import           Data.String           (IsString, fromString)
import           Lens.Micro.Platform   (Lens', makeLenses, over, set)
import           System.Exit           (ExitCode)
import           System.Console.GetOpt (OptDescr, ArgDescr(..))
import           Yi.Config.Lens        (configVariable, startActionsA)
import           Yi.Types              (Action, Config, YiConfigVariable)

data OptionError = OptionError T.Text ExitCode

-- | An option is a function that attempts to change the configuration of the
-- editor at runtime.
type YiOption = Config -> Either OptionError Config

type YiOptionDescr = OptDescr YiOption

-- | Custom options that should be accepted. Provided in user configuration.
--
-- The general flow is that the user adds options to his configuration. Options
-- are essentially functions describing how to modify the configuration at runtime.
-- When an option is called, it gets the current config and may modify it (to encode
-- its value)
newtype YiOptions = YiOptions { YiOptions -> [YiOptionDescr]
_yiOptions :: [YiOptionDescr] }
    deriving (YiOptions
YiOptions -> Default YiOptions
forall a. a -> Default a
def :: YiOptions
$cdef :: YiOptions
Default, Typeable)

instance YiConfigVariable YiOptions

makeLenses ''YiOptions

-- | Lens for accessing the list of custom options.
--
-- You can pretty much create whatever types of options you want with this.
-- But most cases are taken care of by one of the helper functions in this module.
yiCustomOptions :: Lens' Config [YiOptionDescr]
yiCustomOptions :: ([YiOptionDescr] -> f [YiOptionDescr]) -> Config -> f Config
yiCustomOptions = (YiOptions -> f YiOptions) -> Config -> f Config
forall a. YiConfigVariable a => Lens Config Config a a
configVariable ((YiOptions -> f YiOptions) -> Config -> f Config)
-> (([YiOptionDescr] -> f [YiOptionDescr])
    -> YiOptions -> f YiOptions)
-> ([YiOptionDescr] -> f [YiOptionDescr])
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([YiOptionDescr] -> f [YiOptionDescr]) -> YiOptions -> f YiOptions
Lens' YiOptions [YiOptionDescr]
yiOptions

-- | Includes an extra option in the configuration. Small wrapper around 'yiCustomOptions'
consYiOption :: YiOptionDescr -> Config -> Config
consYiOption :: YiOptionDescr -> Config -> Config
consYiOption YiOptionDescr
opt = ASetter Config Config [YiOptionDescr] [YiOptionDescr]
-> ([YiOptionDescr] -> [YiOptionDescr]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [YiOptionDescr] [YiOptionDescr]
Lens' Config [YiOptionDescr]
yiCustomOptions (YiOptionDescr
optYiOptionDescr -> [YiOptionDescr] -> [YiOptionDescr]
forall a. a -> [a] -> [a]
:)

-- | Like 'consYiOption' but supports multiple options. Convenient for keymaps which might
-- want to install lots of options.
consYiOptions :: [YiOptionDescr] -> Config -> Config
consYiOptions :: [YiOptionDescr] -> Config -> Config
consYiOptions [YiOptionDescr]
opts = ASetter Config Config [YiOptionDescr] [YiOptionDescr]
-> ([YiOptionDescr] -> [YiOptionDescr]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [YiOptionDescr] [YiOptionDescr]
Lens' Config [YiOptionDescr]
yiCustomOptions ([YiOptionDescr]
opts[YiOptionDescr] -> [YiOptionDescr] -> [YiOptionDescr]
forall a. [a] -> [a] -> [a]
++)

-- | An argument which sets some configuration value to 'True'.
yiBoolOption :: Lens' Config Bool -> ArgDescr YiOption
yiBoolOption :: Lens' Config Bool -> ArgDescr YiOption
yiBoolOption Lens' Config Bool
lens = YiOption -> ArgDescr YiOption
forall a. a -> ArgDescr a
NoArg (YiOption -> ArgDescr YiOption) -> YiOption -> ArgDescr YiOption
forall a b. (a -> b) -> a -> b
$ YiOption
forall a b. b -> Either a b
Right YiOption -> (Config -> Config) -> YiOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Config Config Bool Bool -> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Config Config Bool Bool
Lens' Config Bool
lens Bool
True

-- | An argument which applies a function transforming some inner value of
-- the configuration.
yiFlagOption :: Lens' Config a -> (a -> a) -> ArgDescr YiOption
yiFlagOption :: Lens' Config a -> (a -> a) -> ArgDescr YiOption
yiFlagOption Lens' Config a
lens a -> a
f = YiOption -> ArgDescr YiOption
forall a. a -> ArgDescr a
NoArg (YiOption -> ArgDescr YiOption) -> YiOption -> ArgDescr YiOption
forall a b. (a -> b) -> a -> b
$ YiOption
forall a b. b -> Either a b
Right YiOption -> (Config -> Config) -> YiOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Config Config a a -> (a -> a) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config a a
Lens' Config a
lens a -> a
f

-- | Flag that appends an action to the startup actions.
yiActionFlagOption :: Action -> ArgDescr YiOption
yiActionFlagOption :: Action -> ArgDescr YiOption
yiActionFlagOption Action
action = YiOption -> ArgDescr YiOption
forall a. a -> ArgDescr a
NoArg YiOption
forall a. Config -> Either a Config
f
    where f :: Config -> Either a Config
f Config
config = Config -> Either a Config
forall a b. b -> Either a b
Right (Config -> Either a Config) -> Config -> Either a Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Action] [Action]
-> ([Action] -> [Action]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Action] [Action]
Lens' Config [Action]
startActionsA ([Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[Action
action]) Config
config
 
-- | Sets the value of an option which is any string type (hopefully text...)
--
-- This is not meant to be fully applied. By only passing in the lens you
-- will obtain a value suitable for use in OptDescr.
yiStringOption :: IsString a => Lens' Config a -> String -> ArgDescr YiOption
yiStringOption :: Lens' Config a -> String -> ArgDescr YiOption
yiStringOption Lens' Config a
lens String
desc = (String -> YiOption) -> String -> ArgDescr YiOption
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> YiOption
forall a. String -> Config -> Either a Config
f String
desc
    where f :: String -> Config -> Either a Config
f String
string Config
config = Config -> Either a Config
forall a b. b -> Either a b
Right (Config -> Either a Config) -> Config -> Either a Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config a a -> a -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Config Config a a
Lens' Config a
lens (String -> a
forall a. IsString a => String -> a
fromString String
string) Config
config

-- | Just like 'yiStringOption', except it applies a 'Just'. Useful for setting
-- string-like values whose default is 'None'.
yiStringOption' :: IsString a => Lens' Config (Maybe a) -> String -> ArgDescr YiOption
yiStringOption' :: Lens' Config (Maybe a) -> String -> ArgDescr YiOption
yiStringOption' Lens' Config (Maybe a)
lens String
desc = (String -> YiOption) -> String -> ArgDescr YiOption
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> YiOption
forall a. String -> Config -> Either a Config
f String
desc
    where f :: String -> Config -> Either a Config
f String
string Config
config = Config -> Either a Config
forall a b. b -> Either a b
Right (Config -> Either a Config) -> Config -> Either a Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (Maybe a) (Maybe a)
-> Maybe a -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Config Config (Maybe a) (Maybe a)
Lens' Config (Maybe a)
lens (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. IsString a => String -> a
fromString String
string) Config
config

-- | Option that appends a parameterized action to the startup actions.
yiActionOption :: IsString a => (a -> Action) -> String -> ArgDescr YiOption
yiActionOption :: (a -> Action) -> String -> ArgDescr YiOption
yiActionOption a -> Action
action String
desc = (String -> YiOption) -> String -> ArgDescr YiOption
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> YiOption
forall a. String -> Config -> Either a Config
f String
desc
    where f :: String -> Config -> Either a Config
f String
string Config
config = Config -> Either a Config
forall a b. b -> Either a b
Right (Config -> Either a Config) -> Config -> Either a Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Action] [Action]
-> ([Action] -> [Action]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Action] [Action]
Lens' Config [Action]
startActionsA ([Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[a -> Action
action (String -> a
forall a. IsString a => String -> a
fromString String
string)]) Config
config

yiActionOption' :: IsString a => (a -> Either OptionError Action) -> String -> ArgDescr YiOption
yiActionOption' :: (a -> Either OptionError Action) -> String -> ArgDescr YiOption
yiActionOption' a -> Either OptionError Action
action String
desc = (String -> YiOption) -> String -> ArgDescr YiOption
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> YiOption
f String
desc
    where f :: String -> YiOption
f String
string Config
config = do
            Action
action' <- a -> Either OptionError Action
action (String -> a
forall a. IsString a => String -> a
fromString String
string)
            YiOption
forall (m :: * -> *) a. Monad m => a -> m a
return YiOption -> YiOption
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Action] [Action]
-> ([Action] -> [Action]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Action] [Action]
Lens' Config [Action]
startActionsA ([Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[Action
action']) Config
config