{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Categorises command-line options according to their nature:

		** The optional path to a single configuration-file.

		** Requests for information which doesn't require access to the configuration.

		** Requests for information which requires access to the configuration.

		** Options-mutators.

	* These categories are processed in a specific order, & some terminate the application.
-}

module BishBosh.Input.CategorisedCommandLineOptions(
-- * Types
-- ** Type-synonyms
	IOAction,
	ContextualIOAction,
	OptionsMutator,
--	Transformation,
-- ** Data-types
	CategorisedCommandLineOptions(
--		MkCategorisedCommandLineOptions,
		getMaybeConfigLocationParameter,
		getIOActions,
		getContextualIOActions,
		getOptionsMutators
	),
-- * Functions
-- ** Mutators
	setConfigLocation,
	prependIOAction,
	prependContextualIOAction,
	prependOptionsMutator
) where

import qualified	BishBosh.Property.Empty	as Property.Empty
import qualified	System.FilePath

-- | Type-synonym.
type IOAction	= IO ()

-- | Type-synonym.
type ContextualIOAction options	= options -> IOAction

-- | Type-synonym.
type OptionsMutator options	= options -> options

-- | The set of ordered command-line options partitioned into categories.
data CategorisedCommandLineOptions options	= MkCategorisedCommandLineOptions {
	CategorisedCommandLineOptions options -> Maybe FilePath
getMaybeConfigLocationParameter	:: Maybe System.FilePath.FilePath,	-- ^ A command-line option which specifies the location of some configuration.
	CategorisedCommandLineOptions options -> [IOAction]
getIOActions			:: [IOAction],				-- ^ Command-line options which request an IO-action. N.B. they don't have access to the configuration.
	CategorisedCommandLineOptions options
-> [ContextualIOAction options]
getContextualIOActions		:: [ContextualIOAction options],	-- ^ Command-line options which request an IO-action, which has access to the configuration.
	CategorisedCommandLineOptions options -> [OptionsMutator options]
getOptionsMutators		:: [OptionsMutator options]		-- ^ Command-line options which directly specify configuration-parameters.
}

instance Property.Empty.Empty (CategorisedCommandLineOptions options) where
	empty :: CategorisedCommandLineOptions options
empty	= MkCategorisedCommandLineOptions :: forall options.
Maybe FilePath
-> [IOAction]
-> [ContextualIOAction options]
-> [OptionsMutator options]
-> CategorisedCommandLineOptions options
MkCategorisedCommandLineOptions {
		getMaybeConfigLocationParameter :: Maybe FilePath
getMaybeConfigLocationParameter	= Maybe FilePath
forall a. Empty a => a
Property.Empty.empty,
		getIOActions :: [IOAction]
getIOActions			= [IOAction]
forall a. Empty a => a
Property.Empty.empty,
		getContextualIOActions :: [ContextualIOAction options]
getContextualIOActions		= [ContextualIOAction options]
forall a. Empty a => a
Property.Empty.empty,
		getOptionsMutators :: [OptionsMutator options]
getOptionsMutators		= [OptionsMutator options]
forall a. Empty a => a
Property.Empty.empty
	}

-- | Transformation
type Transformation options	= CategorisedCommandLineOptions options -> CategorisedCommandLineOptions options

-- | Mutator. CAVEAT: overwrites any previous specification.
setConfigLocation :: System.FilePath.FilePath -> Transformation options
setConfigLocation :: FilePath -> Transformation options
setConfigLocation FilePath
filePath CategorisedCommandLineOptions options
categorisedCommandLineOptions	= CategorisedCommandLineOptions options
categorisedCommandLineOptions { getMaybeConfigLocationParameter :: Maybe FilePath
getMaybeConfigLocationParameter = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filePath }

-- | Mutator.
prependIOAction :: IOAction -> Transformation options
prependIOAction :: IOAction -> Transformation options
prependIOAction IOAction
ioAction CategorisedCommandLineOptions options
categorisedCommandLineOptions	= CategorisedCommandLineOptions options
categorisedCommandLineOptions { getIOActions :: [IOAction]
getIOActions = IOAction
ioAction IOAction -> [IOAction] -> [IOAction]
forall a. a -> [a] -> [a]
: CategorisedCommandLineOptions options -> [IOAction]
forall options. CategorisedCommandLineOptions options -> [IOAction]
getIOActions CategorisedCommandLineOptions options
categorisedCommandLineOptions }

-- | Mutator.
prependContextualIOAction :: ContextualIOAction options -> Transformation options
prependContextualIOAction :: ContextualIOAction options -> Transformation options
prependContextualIOAction ContextualIOAction options
contextualIOAction CategorisedCommandLineOptions options
categorisedCommandLineOptions	= CategorisedCommandLineOptions options
categorisedCommandLineOptions { getContextualIOActions :: [ContextualIOAction options]
getContextualIOActions = ContextualIOAction options
contextualIOAction ContextualIOAction options
-> [ContextualIOAction options] -> [ContextualIOAction options]
forall a. a -> [a] -> [a]
: CategorisedCommandLineOptions options
-> [ContextualIOAction options]
forall options.
CategorisedCommandLineOptions options
-> [ContextualIOAction options]
getContextualIOActions CategorisedCommandLineOptions options
categorisedCommandLineOptions }

-- | Mutator.
prependOptionsMutator :: OptionsMutator options -> Transformation options
prependOptionsMutator :: OptionsMutator options -> Transformation options
prependOptionsMutator OptionsMutator options
optionsMutator CategorisedCommandLineOptions options
categorisedCommandLineOptions	= CategorisedCommandLineOptions options
categorisedCommandLineOptions { getOptionsMutators :: [OptionsMutator options]
getOptionsMutators = OptionsMutator options
optionsMutator OptionsMutator options
-> [OptionsMutator options] -> [OptionsMutator options]
forall a. a -> [a] -> [a]
: CategorisedCommandLineOptions options -> [OptionsMutator options]
forall options.
CategorisedCommandLineOptions options -> [OptionsMutator options]
getOptionsMutators CategorisedCommandLineOptions options
categorisedCommandLineOptions }