{-# LANGUAGE LambdaCase #-}
{-
	Copyright (C) 2018 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@]	To facilitate processing of command-line options.
-}

module BishBosh.Input.CommandLineOption(
-- * Types
-- ** Type-synonyms
	Flag,
-- ** Data-types
	CommandLineOption(
--		ConfigLocationParameter,
--		IOAction,
--		OptionsMutator
	),
-- * Constants
	longFlagPrefix,
-- * Functions
	categorise,
	getArgs,
--	read',
	readArg,
	readBoundedIntegral,
-- ** Constructors
	mkConfigLocationParameter,
	mkIOAction,
	mkContextualIOAction,
	mkOptionsMutator
) where

import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Input.CategorisedCommandLineOptions	as Input.CategorisedCommandLineOptions
import qualified	BishBosh.Property.Empty				as Property.Empty
import qualified	Control.Exception
import qualified	Data.List
import qualified	System.FilePath

-- | Synonym.
type Flag	= String

-- | The sum-type of categories of command-line option.
data CommandLineOption options
	= ConfigLocationParameter System.FilePath.FilePath					-- ^ A command-line option which specifies the location of some configuration.
	| IOAction Input.CategorisedCommandLineOptions.IOAction					-- ^ A command-line option which requests an IO-action. N.B. it doesn't have access to the configuration.
	| ContextualIOAction (Input.CategorisedCommandLineOptions.ContextualIOAction options)	-- ^ A command-line option which requests an IO-action, which has access to the configuration.
	| OptionsMutator (Input.CategorisedCommandLineOptions.OptionsMutator options)		-- ^ A command-line option which directly specifies a configuration-parameter.

-- | Constructor.
mkConfigLocationParameter :: System.FilePath.FilePath -> CommandLineOption options
mkConfigLocationParameter :: FilePath -> CommandLineOption options
mkConfigLocationParameter	= FilePath -> CommandLineOption options
forall options. FilePath -> CommandLineOption options
ConfigLocationParameter

-- | Constructor.
mkIOAction :: Input.CategorisedCommandLineOptions.IOAction -> CommandLineOption options
mkIOAction :: IOAction -> CommandLineOption options
mkIOAction	= IOAction -> CommandLineOption options
forall options. IOAction -> CommandLineOption options
IOAction

-- | Constructor.
mkContextualIOAction :: Input.CategorisedCommandLineOptions.ContextualIOAction options -> CommandLineOption options
mkContextualIOAction :: ContextualIOAction options -> CommandLineOption options
mkContextualIOAction	= ContextualIOAction options -> CommandLineOption options
forall options.
ContextualIOAction options -> CommandLineOption options
ContextualIOAction

-- | Constructor.
mkOptionsMutator :: Input.CategorisedCommandLineOptions.OptionsMutator options -> CommandLineOption options
mkOptionsMutator :: OptionsMutator options -> CommandLineOption options
mkOptionsMutator	= OptionsMutator options -> CommandLineOption options
forall options. OptionsMutator options -> CommandLineOption options
OptionsMutator

{- |
	* Partition a list of /CommandLineOption/s according to their data-constructor.

	* N.B.: preserves the order of all specifications sharing a data-constructor.
-}
categorise :: [CommandLineOption options] -> Input.CategorisedCommandLineOptions.CategorisedCommandLineOptions options
categorise :: [CommandLineOption options]
-> CategorisedCommandLineOptions options
categorise	= (CommandLineOption options
 -> CategorisedCommandLineOptions options
 -> CategorisedCommandLineOptions options)
-> CategorisedCommandLineOptions options
-> [CommandLineOption options]
-> CategorisedCommandLineOptions options
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
	\case
		ConfigLocationParameter FilePath
f	-> FilePath
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. FilePath -> Transformation options
Input.CategorisedCommandLineOptions.setConfigLocation FilePath
f	-- CAVEAT: overwrites any previous specification.
		IOAction IOAction
a			-> IOAction
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. IOAction -> Transformation options
Input.CategorisedCommandLineOptions.prependIOAction IOAction
a
		ContextualIOAction ContextualIOAction options
a		-> ContextualIOAction options
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options.
ContextualIOAction options -> Transformation options
Input.CategorisedCommandLineOptions.prependContextualIOAction ContextualIOAction options
a
		OptionsMutator OptionsMutator options
m		-> OptionsMutator options
-> CategorisedCommandLineOptions options
-> CategorisedCommandLineOptions options
forall options. OptionsMutator options -> Transformation options
Input.CategorisedCommandLineOptions.prependOptionsMutator OptionsMutator options
m
 ) CategorisedCommandLineOptions options
forall a. Empty a => a
Property.Empty.empty

-- | The prefix used to denote the long form of a command-line flag.
longFlagPrefix :: Flag
longFlagPrefix :: FilePath
longFlagPrefix	= FilePath
"--"

{- |
	* Return the list of arguments extracted from the specified command-line, which match the specified flag.

	* CAVEAT:
		All unique abbreviations must also be supplied.
		Doesn't cope with short flags preceded by '-'.
-}
getArgs
	:: [Flag]	-- ^ The list acceptible abbreviations for the required flag, each preceded by "--".
	-> [String]	-- ^ The command-line arguments to search.
	-> [String]	-- ^ The matching argument-values.
getArgs :: [FilePath] -> [FilePath] -> [FilePath]
getArgs [FilePath]
flags	= [FilePath] -> [FilePath]
slave where
	slave :: [String] -> [String]
	slave :: [FilePath] -> [FilePath]
slave []	= []
	slave (FilePath
x : [FilePath]
xs)
		| FilePath
x FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
flags	= case [FilePath]
xs of
			FilePath
s : [FilePath]
remainder	-> FilePath
s FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
slave [FilePath]
remainder {-recurse-}
			[]		-> Exception -> [FilePath]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [FilePath])
-> (FilePath -> Exception) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkInsufficientData (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"option " (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
x FilePath
" requires an argument."
		| (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
			(FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Data.List.isPrefixOf` FilePath
x) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=")
		) [FilePath]
flags			= case (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') FilePath
x of
			Char
_ : FilePath
remainder	-> FilePath
remainder FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
slave [FilePath]
xs
			[]		-> Exception -> [FilePath]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [FilePath])
-> (FilePath -> Exception) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkNullDatum (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"option " (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
x FilePath
" requires a non-null argument."
		| Bool
otherwise		= [FilePath] -> [FilePath]
slave [FilePath]
xs	-- Recurse.

-- | Parse the specified string, throwing an exception on failure.
read' :: Read a => String -> String -> a
read' :: FilePath -> FilePath -> a
read' FilePath
errorMessage FilePath
s	= case ReadS a
forall a. Read a => ReadS a
reads FilePath
s of
	[(a
x, FilePath
"")]	-> a
x
	[(a, FilePath)]
_		-> Exception -> a
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> a) -> (FilePath -> Exception) -> FilePath -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkParseFailure (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
errorMessage (FilePath -> a) -> FilePath -> a
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows FilePath
s FilePath
"."

-- | Parse the specified string, returning the specified explanatory error-message on failure.
readArg :: Read a => String -> a
readArg :: FilePath -> a
readArg	= FilePath -> FilePath -> a
forall a. Read a => FilePath -> FilePath -> a
read' FilePath
"failed to parse command-line argument "

-- | Reads a bounded integral value from the command-line, guarding against overflow.
readBoundedIntegral :: Integral i => String -> i
readBoundedIntegral :: FilePath -> i
readBoundedIntegral FilePath
s
	| i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
bounded Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
unbounded	= Exception -> i
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> i) -> (FilePath -> Exception) -> FilePath -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Exception
Data.Exception.mkOutOfBounds (FilePath -> Exception)
-> (FilePath -> FilePath) -> FilePath -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"BishBosh.Input.CommandLineOption.readBoundedIntegral:\tintegral value exceeds permissible bounds; " (FilePath -> i) -> FilePath -> i
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows Integer
unbounded FilePath
"."
	| Bool
otherwise				= i
bounded
	where
		unbounded :: Integer
unbounded	= FilePath -> Integer
forall a. Read a => FilePath -> a
readArg FilePath
s
		bounded :: i
bounded		= Integer -> i
forall a. Num a => Integer -> a
fromInteger Integer
unbounded