{- |

Handling for the command-line options that can be used to configure
Dyre. As of the last count, there are four of them, and more are
unlikely to be needed. The only one that a user should ever need to
use is the @--force-reconf@ option, so the others all begin with
@--dyre-<option-name>@.

At the start of the program, before anything else occurs, the
'withDyreOptions' function is used to hide Dyre's command-line
options. They are loaded into the @IO@ monad using the module
"System.IO.Storage". This keeps them safely out of the way of
the user code and our own.

Later, when Dyre needs to access the options, it does so through
the accessor functions defined here. When it comes time to pass
control over to a new binary, it gets an argument list which
preserves the important flags with a call to 'customOptions'.

-}
module Config.Dyre.Options
  ( removeDyreOptions
  , withDyreOptions
  , customOptions
  , getDenyReconf
  , getForceReconf
  , getDebug
  , getMasterBinary
  , getStatePersist
  ) where

import Data.List                     (isPrefixOf)
import Data.Maybe                    (fromMaybe)
import System.IO.Storage             (withStore, putValue, getValue, getDefaultValue)
import System.Environment            (getArgs, getProgName, withArgs)
import System.Environment.Executable (getExecutablePath)

import Config.Dyre.Params

-- | Remove all Dyre's options from the given commandline arguments.
removeDyreOptions :: [String] -> [String]
removeDyreOptions :: [String] -> [String]
removeDyreOptions = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Bool) -> [String] -> [String])
-> (String -> Bool) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String -> Bool
forall a. Eq a => [[a]] -> [a] -> Bool
prefixElem [String]
dyreArgs
  where prefixElem :: [[a]] -> [a] -> Bool
prefixElem [[a]]
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([a] -> [Bool]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a] -> Bool) -> [a] -> Bool) -> [[a] -> Bool] -> [[a]] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
($) (([a] -> [a] -> Bool) -> [[a]] -> [[a] -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [[a]]
xs) ([[a]] -> [Bool]) -> ([a] -> [[a]]) -> [a] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. a -> [a]
repeat

-- | Store Dyre's command-line options to the IO-Store "dyre",
--   and then execute the provided IO action with all Dyre's
--   options removed from the command-line arguments.
withDyreOptions :: Params c r -> IO a -> IO a
withDyreOptions :: Params c r -> IO a -> IO a
withDyreOptions Params{configCheck :: forall cfgType a. Params cfgType a -> Bool
configCheck = Bool
check} IO a
action = String -> IO a -> IO a
forall a. String -> IO a -> IO a
withStore String
"dyre" (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    -- Pretty important
    [String]
args <- IO [String]
getArgs

    -- If the flag exists, it overrides the current file. Likewise,
    --   if it doesn't exist, we end up with the path to our current
    --   file. This seems like a sensible way to do it.
    -- Don't use 'getExecutablePath' if we're byassing the rest of Dyre.
    String
this <- if Bool
check then IO String
getExecutablePath else IO String
getProgName
    String -> String -> String -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
"masterBinary" String
this
    [String] -> String -> String -> IO ()
storeFlag [String]
args String
"--dyre-master-binary=" String
"masterBinary"

    -- Load the other important arguments into IO storage.
    [String] -> String -> String -> IO ()
storeFlag [String]
args String
"--dyre-state-persist=" String
"persistState"
    String -> String -> Bool -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
"forceReconf"  (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--force-reconf" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args
    String -> String -> Bool -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
"denyReconf"   (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--deny-reconf"  String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args
    String -> String -> Bool -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
"debugMode"    (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--dyre-debug"   String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args

    -- We filter the arguments, so now Dyre's arguments 'vanish'
    [String] -> IO a -> IO a
forall a. [String] -> IO a -> IO a
withArgs ([String] -> [String]
removeDyreOptions [String]
args) IO a
action

-- | Get the value of the @--force-reconf@ flag, which is used
--   to force a recompile of the custom configuration.
getForceReconf :: IO Bool
getForceReconf :: IO Bool
getForceReconf = String -> String -> Bool -> IO Bool
forall a. Typeable a => String -> String -> a -> IO a
getDefaultValue String
"dyre" String
"forceReconf" Bool
False

-- | Get the value of the @--deny-reconf@ flag, which disables
--   recompilation. This overrides "--force-reconf", too.
getDenyReconf :: IO Bool
getDenyReconf :: IO Bool
getDenyReconf = String -> String -> Bool -> IO Bool
forall a. Typeable a => String -> String -> a -> IO a
getDefaultValue String
"dyre" String
"denyReconf" Bool
False

-- | Get the value of the @--dyre-debug@ flag, which is used
--   to debug a program without installation. Specifically,
--   it forces the application to use @./cache/@ as the cache
--   directory, and @./@ as the configuration directory.
getDebug  :: IO Bool
getDebug :: IO Bool
getDebug = String -> String -> Bool -> IO Bool
forall a. Typeable a => String -> String -> a -> IO a
getDefaultValue String
"dyre" String
"debugMode" Bool
False

-- | Get the path to the master binary. This is set to the path of
--   the /current/ binary unless the @--dyre-master-binary=@ flag
--   is set. Obviously, we pass the @--dyre-master-binary=@ flag to
--   the custom configured application from the master binary.
getMasterBinary :: IO (Maybe String)
getMasterBinary :: IO (Maybe String)
getMasterBinary = String -> String -> IO (Maybe String)
forall a. Typeable a => String -> String -> IO (Maybe a)
getValue String
"dyre" String
"masterBinary"

-- | Get the path to a persistent state file. This is set only when
--   the @--dyre-state-persist=@ flag is passed to the program. It
--   is used internally by "Config.Dyre.Relaunch" to save and restore
--   state when relaunching the program.
getStatePersist :: IO (Maybe String)
getStatePersist :: IO (Maybe String)
getStatePersist = String -> String -> IO (Maybe String)
forall a. Typeable a => String -> String -> IO (Maybe a)
getValue String
"dyre" String
"persistState"

-- | Return the set of options which will be passed to another instance
--   of Dyre. Preserves the master binary, state file, and debug mode
--   flags, but doesn't pass along the forced-recompile flag. Can be
--   passed a set of other arguments to use, or it defaults to using
--   the current arguments when passed 'Nothing'.
customOptions :: Maybe [String] -> IO [String]
customOptions :: Maybe [String] -> IO [String]
customOptions Maybe [String]
otherArgs = do
    Maybe String
masterPath <- IO (Maybe String)
getMasterBinary
    Maybe String
stateFile  <- IO (Maybe String)
getStatePersist
    Bool
debugMode  <- IO Bool
getDebug
    [String]
mainArgs <- IO [String]
-> ([String] -> IO [String]) -> Maybe [String] -> IO [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO [String]
getArgs [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [String]
otherArgs

    -- Combine the other arguments with the Dyre-specific ones
    [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
mainArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [String
"--dyre-debug" | Bool
debugMode]
        , [String
"--dyre-state-persist=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sf | Just String
sf <- [Maybe String
stateFile]]
        , [ String
"--dyre-master-binary="
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error String
"'dyre' data-store doesn't exist (in Config.Dyre.Options.customOptions)") Maybe String
masterPath]
        ]

-- | Look for the given flag in the argument array, and store
--   its value under the given name if it exists.
storeFlag :: [String] -> String -> String -> IO ()
storeFlag :: [String] -> String -> String -> IO ()
storeFlag [String]
args String
flag String
name
    | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
match  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise   = String -> String -> String -> IO ()
forall a. Typeable a => String -> String -> a -> IO ()
putValue String
"dyre" String
name (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
flag) ([String] -> String
forall a. [a] -> a
head [String]
match)
  where match :: [String]
match = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
flag) [String]
args

-- | The array of all arguments that Dyre recognizes. Used to
--   make sure none of them are visible past 'withDyreOptions'
dyreArgs :: [String]
dyreArgs :: [String]
dyreArgs = [ String
"--force-reconf", String
"--deny-reconf"
           , String
"--dyre-state-persist", String
"--dyre-debug"
           , String
"--dyre-master-binary" ]