{-# LANGUAGE TypeFamilies #-}

-- |
-- Module: Options.Tokenize
-- License: MIT
module Options.Tokenize
	( Token(..)
	, tokenFlagName
	, Tokens(..)
	, tokensMap
	, tokenize
	) where

import           Control.Applicative
import           Control.Monad.Error hiding (throwError)
import qualified Control.Monad.Error
import           Control.Monad.State
import           Data.Functor.Identity
import qualified Data.Map

import           Options.Types
import           Options.Util

data Token
	= TokenUnary String -- flag name
	| Token String String -- flag name, flag value
	deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

tokenFlagName :: Token -> String
tokenFlagName :: Token -> String
tokenFlagName (TokenUnary s :: String
s) = String
s
tokenFlagName (Token s :: String
s _) = String
s

data Tokens = Tokens
	{ Tokens -> [([OptionKey], Token)]
tokensList :: [([OptionKey], Token)]
	, Tokens -> [String]
tokensArgv :: [String]
	}
	deriving (Int -> Tokens -> ShowS
[Tokens] -> ShowS
Tokens -> String
(Int -> Tokens -> ShowS)
-> (Tokens -> String) -> ([Tokens] -> ShowS) -> Show Tokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tokens] -> ShowS
$cshowList :: [Tokens] -> ShowS
show :: Tokens -> String
$cshow :: Tokens -> String
showsPrec :: Int -> Tokens -> ShowS
$cshowsPrec :: Int -> Tokens -> ShowS
Show)

tokensMap :: Tokens -> Data.Map.Map OptionKey [Token]
tokensMap :: Tokens -> Map OptionKey [Token]
tokensMap tokens :: Tokens
tokens = ([Token] -> [Token] -> [Token])
-> [(OptionKey, [Token])] -> Map OptionKey [Token]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Data.Map.fromListWith (\xs :: [Token]
xs ys :: [Token]
ys -> [Token]
ys [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
xs) ([(OptionKey, [Token])] -> Map OptionKey [Token])
-> [(OptionKey, [Token])] -> Map OptionKey [Token]
forall a b. (a -> b) -> a -> b
$ do
	(keys :: [OptionKey]
keys, token :: Token
token) <- Tokens -> [([OptionKey], Token)]
tokensList Tokens
tokens
	OptionKey
key <- [OptionKey]
keys
	(OptionKey, [Token]) -> [(OptionKey, [Token])]
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionKey
key, [Token
token])

data TokState = TokState
	{ TokState -> [String]
stArgv :: [String]
	, TokState -> [String]
stArgs :: [String]
	, TokState -> [([OptionKey], Token)]
stOpts :: [([OptionKey], Token)]
	, TokState -> Map Char ([OptionKey], OptionInfo)
stShortKeys :: Data.Map.Map Char ([OptionKey], OptionInfo)
	, TokState -> Map String ([OptionKey], OptionInfo)
stLongKeys :: Data.Map.Map String ([OptionKey], OptionInfo)
	, TokState -> [(String, [OptionInfo])]
stSubcommands :: [(String, [OptionInfo])]
	, TokState -> Maybe String
stSubCmd :: Maybe String
	}

newtype Tok a = Tok { Tok a -> ErrorT String (StateT TokState Identity) a
unTok :: ErrorT String (StateT TokState Identity) a }

instance Functor Tok where
	fmap :: (a -> b) -> Tok a -> Tok b
fmap = (a -> b) -> Tok a -> Tok b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Tok where
	pure :: a -> Tok a
pure = a -> Tok a
forall (m :: * -> *) a. Monad m => a -> m a
return
	<*> :: Tok (a -> b) -> Tok a -> Tok b
(<*>) = Tok (a -> b) -> Tok a -> Tok b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Tok where
	return :: a -> Tok a
return = ErrorT String (StateT TokState Identity) a -> Tok a
forall a. ErrorT String (StateT TokState Identity) a -> Tok a
Tok (ErrorT String (StateT TokState Identity) a -> Tok a)
-> (a -> ErrorT String (StateT TokState Identity) a) -> a -> Tok a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorT String (StateT TokState Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return
	m :: Tok a
m >>= :: Tok a -> (a -> Tok b) -> Tok b
>>= f :: a -> Tok b
f = ErrorT String (StateT TokState Identity) b -> Tok b
forall a. ErrorT String (StateT TokState Identity) a -> Tok a
Tok (Tok a -> ErrorT String (StateT TokState Identity) a
forall a. Tok a -> ErrorT String (StateT TokState Identity) a
unTok Tok a
m ErrorT String (StateT TokState Identity) a
-> (a -> ErrorT String (StateT TokState Identity) b)
-> ErrorT String (StateT TokState Identity) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tok b -> ErrorT String (StateT TokState Identity) b
forall a. Tok a -> ErrorT String (StateT TokState Identity) a
unTok (Tok b -> ErrorT String (StateT TokState Identity) b)
-> (a -> Tok b) -> a -> ErrorT String (StateT TokState Identity) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Tok b
f)

instance MonadState Tok where
	type StateType Tok = TokState
	get :: Tok (StateType Tok)
get = ErrorT String (StateT TokState Identity) TokState -> Tok TokState
forall a. ErrorT String (StateT TokState Identity) a -> Tok a
Tok ErrorT String (StateT TokState Identity) TokState
forall (m :: * -> *). MonadState m => m (StateType m)
get
	put :: StateType Tok -> Tok ()
put = ErrorT String (StateT TokState Identity) () -> Tok ()
forall a. ErrorT String (StateT TokState Identity) a -> Tok a
Tok (ErrorT String (StateT TokState Identity) () -> Tok ())
-> (TokState -> ErrorT String (StateT TokState Identity) ())
-> TokState
-> Tok ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokState -> ErrorT String (StateT TokState Identity) ()
forall (m :: * -> *). MonadState m => StateType m -> m ()
put

tokenize :: OptionDefinitions -> [String] -> (Maybe String, Either String Tokens)
tokenize :: OptionDefinitions
-> [String] -> (Maybe String, Either String Tokens)
tokenize (OptionDefinitions options :: [OptionInfo]
options subcommands :: [(String, [OptionInfo])]
subcommands) argv :: [String]
argv = Identity (Maybe String, Either String Tokens)
-> (Maybe String, Either String Tokens)
forall a. Identity a -> a
runIdentity (Identity (Maybe String, Either String Tokens)
 -> (Maybe String, Either String Tokens))
-> Identity (Maybe String, Either String Tokens)
-> (Maybe String, Either String Tokens)
forall a b. (a -> b) -> a -> b
$ do
	let st :: TokState
st = TokState :: [String]
-> [String]
-> [([OptionKey], Token)]
-> Map Char ([OptionKey], OptionInfo)
-> Map String ([OptionKey], OptionInfo)
-> [(String, [OptionInfo])]
-> Maybe String
-> TokState
TokState
		{ stArgv :: [String]
stArgv = [String]
argv
		, stArgs :: [String]
stArgs = []
		, stOpts :: [([OptionKey], Token)]
stOpts = []
		, stShortKeys :: Map Char ([OptionKey], OptionInfo)
stShortKeys = [OptionInfo] -> Map Char ([OptionKey], OptionInfo)
toShortKeys [OptionInfo]
options
		, stLongKeys :: Map String ([OptionKey], OptionInfo)
stLongKeys = [OptionInfo] -> Map String ([OptionKey], OptionInfo)
toLongKeys [OptionInfo]
options
		, stSubcommands :: [(String, [OptionInfo])]
stSubcommands = [(String, [OptionInfo])]
subcommands
		, stSubCmd :: Maybe String
stSubCmd = Maybe String
forall a. Maybe a
Nothing
		}
	(err :: Either String ()
err, st' :: TokState
st') <- StateT TokState Identity (Either String ())
-> TokState -> Identity (Either String (), TokState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ErrorT String (StateT TokState Identity) ()
-> StateT TokState Identity (Either String ())
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (Tok () -> ErrorT String (StateT TokState Identity) ()
forall a. Tok a -> ErrorT String (StateT TokState Identity) a
unTok Tok ()
loop)) TokState
st
	(Maybe String, Either String Tokens)
-> Identity (Maybe String, Either String Tokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (TokState -> Maybe String
stSubCmd TokState
st', case Either String ()
err of
		Left err' :: String
err' -> String -> Either String Tokens
forall a b. a -> Either a b
Left String
err'
		Right _ -> Tokens -> Either String Tokens
forall a b. b -> Either a b
Right ([([OptionKey], Token)] -> [String] -> Tokens
Tokens ([([OptionKey], Token)] -> [([OptionKey], Token)]
forall a. [a] -> [a]
reverse (TokState -> [([OptionKey], Token)]
stOpts TokState
st')) (TokState -> [String]
stArgs TokState
st')))

loop :: Tok ()
loop :: Tok ()
loop = do
	Maybe String
ms <- Tok (Maybe String)
nextItem
	TokState
st <- Tok TokState
forall (m :: * -> *). MonadState m => m (StateType m)
get
	case Maybe String
ms of
		Nothing -> () -> Tok ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
		Just s :: String
s -> (Tok () -> Tok () -> Tok ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tok ()
loop) (Tok () -> Tok ()) -> Tok () -> Tok ()
forall a b. (a -> b) -> a -> b
$ case ShowS
stringToGhc704 String
s of
			'-':'-':[] -> StateType Tok -> Tok ()
forall (m :: * -> *). MonadState m => StateType m -> m ()
put (TokState
st { stArgv :: [String]
stArgv = [], stArgs :: [String]
stArgs = TokState -> [String]
stArgs TokState
st [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ TokState -> [String]
stArgv TokState
st })
			'-':'-':opt :: String
opt -> String -> Tok ()
parseLong String
opt
			'-':optChar :: Char
optChar:optValue :: String
optValue -> Char -> String -> Tok ()
parseShort Char
optChar String
optValue
			'-':[] -> String -> Tok ()
addArg String
s
			decoded :: String
decoded -> case (TokState -> [(String, [OptionInfo])]
stSubcommands TokState
st, TokState -> Maybe String
stSubCmd TokState
st) of
				([], _) -> String -> Tok ()
addArg String
s
				(_, Just _) -> String -> Tok ()
addArg String
s
				(_, Nothing) -> case String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
decoded (TokState -> [(String, [OptionInfo])]
stSubcommands TokState
st) of
					Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("Unknown subcommand " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
decoded String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".")
					Just subOptions :: [OptionInfo]
subOptions -> String -> [OptionInfo] -> Tok ()
mergeSubcommand String
decoded [OptionInfo]
subOptions

nextItem :: Tok (Maybe String)
nextItem :: Tok (Maybe String)
nextItem = do
	TokState
st <- Tok TokState
forall (m :: * -> *). MonadState m => m (StateType m)
get
	case TokState -> [String]
stArgv TokState
st of
		[] -> Maybe String -> Tok (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
		(x :: String
x:xs :: [String]
xs) -> do
			StateType Tok -> Tok ()
forall (m :: * -> *). MonadState m => StateType m -> m ()
put (TokState
st { stArgv :: [String]
stArgv = [String]
xs })
			Maybe String -> Tok (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
x)

addArg :: String -> Tok ()
addArg :: String -> Tok ()
addArg s :: String
s = (StateType Tok -> StateType Tok) -> Tok ()
forall (m :: * -> *).
MonadState m =>
(StateType m -> StateType m) -> m ()
modify (\st :: StateType Tok
st -> StateType Tok
TokState
st { stArgs :: [String]
stArgs = TokState -> [String]
stArgs StateType Tok
TokState
st [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
s] })

addOpt :: [OptionKey] -> Token  -> Tok ()
addOpt :: [OptionKey] -> Token -> Tok ()
addOpt keys :: [OptionKey]
keys val :: Token
val = (StateType Tok -> StateType Tok) -> Tok ()
forall (m :: * -> *).
MonadState m =>
(StateType m -> StateType m) -> m ()
modify (\st :: StateType Tok
st -> StateType Tok
TokState
st
	{ stOpts :: [([OptionKey], Token)]
stOpts = ([OptionKey]
keys, Token
val) ([OptionKey], Token)
-> [([OptionKey], Token)] -> [([OptionKey], Token)]
forall a. a -> [a] -> [a]
: TokState -> [([OptionKey], Token)]
stOpts StateType Tok
TokState
st
	})

mergeSubcommand :: String -> [OptionInfo] -> Tok ()
mergeSubcommand :: String -> [OptionInfo] -> Tok ()
mergeSubcommand name :: String
name opts :: [OptionInfo]
opts = (StateType Tok -> StateType Tok) -> Tok ()
forall (m :: * -> *).
MonadState m =>
(StateType m -> StateType m) -> m ()
modify ((StateType Tok -> StateType Tok) -> Tok ())
-> (StateType Tok -> StateType Tok) -> Tok ()
forall a b. (a -> b) -> a -> b
$ \st :: StateType Tok
st -> StateType Tok
TokState
st
	{ stSubCmd :: Maybe String
stSubCmd = String -> Maybe String
forall a. a -> Maybe a
Just String
name
	, stShortKeys :: Map Char ([OptionKey], OptionInfo)
stShortKeys = (([OptionKey], OptionInfo)
 -> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo))
-> Map Char ([OptionKey], OptionInfo)
-> Map Char ([OptionKey], OptionInfo)
-> Map Char ([OptionKey], OptionInfo)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Data.Map.unionWith ([OptionKey], OptionInfo)
-> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo)
unionKeys (TokState -> Map Char ([OptionKey], OptionInfo)
stShortKeys StateType Tok
TokState
st) ([OptionInfo] -> Map Char ([OptionKey], OptionInfo)
toShortKeys [OptionInfo]
opts)
	, stLongKeys :: Map String ([OptionKey], OptionInfo)
stLongKeys = (([OptionKey], OptionInfo)
 -> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo))
-> Map String ([OptionKey], OptionInfo)
-> Map String ([OptionKey], OptionInfo)
-> Map String ([OptionKey], OptionInfo)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Data.Map.unionWith ([OptionKey], OptionInfo)
-> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo)
unionKeys (TokState -> Map String ([OptionKey], OptionInfo)
stLongKeys StateType Tok
TokState
st) ([OptionInfo] -> Map String ([OptionKey], OptionInfo)
toLongKeys [OptionInfo]
opts)
	}

-- note: unionKeys assumes that the OptionInfo is equivalent in both maps.
unionKeys :: ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo)
unionKeys :: ([OptionKey], OptionInfo)
-> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo)
unionKeys (keys1 :: [OptionKey]
keys1, info :: OptionInfo
info) (keys2 :: [OptionKey]
keys2,_) = ([OptionKey]
keys1[OptionKey] -> [OptionKey] -> [OptionKey]
forall a. [a] -> [a] -> [a]
++[OptionKey]
keys2, OptionInfo
info)

parseLong :: String -> Tok ()
parseLong :: String -> Tok ()
parseLong optName :: String
optName = do
	Map String ([OptionKey], OptionInfo)
longKeys <- (StateType Tok -> Map String ([OptionKey], OptionInfo))
-> Tok (Map String ([OptionKey], OptionInfo))
forall (m :: * -> *) a. MonadState m => (StateType m -> a) -> m a
gets StateType Tok -> Map String ([OptionKey], OptionInfo)
TokState -> Map String ([OptionKey], OptionInfo)
stLongKeys
	case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') String
optName of
		(before :: String
before, after :: String
after) -> case String
after of
			'=' : value :: String
value -> case String
-> Map String ([OptionKey], OptionInfo)
-> Maybe ([OptionKey], OptionInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup String
before Map String ([OptionKey], OptionInfo)
longKeys of
				Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("Unknown flag --" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
before)
				Just (keys :: [OptionKey]
keys, info :: OptionInfo
info) -> if OptionInfo -> Bool
optionInfoUnaryOnly OptionInfo
info
					then String -> Tok ()
forall a. String -> Tok a
throwError ("Flag --" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
before String -> ShowS
forall a. [a] -> [a] -> [a]
++ " takes no parameters.")
					else [OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> String -> Token
Token ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
before) String
value)
			_ -> case String
-> Map String ([OptionKey], OptionInfo)
-> Maybe ([OptionKey], OptionInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup String
optName Map String ([OptionKey], OptionInfo)
longKeys of
				Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("Unknown flag --" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName)
				Just (keys :: [OptionKey]
keys, info :: OptionInfo
info) -> if OptionInfo -> Bool
optionInfoUnary OptionInfo
info
					then [OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> Token
TokenUnary ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName))
					else do
						Maybe String
next <- Tok (Maybe String)
nextItem
						case Maybe String
next of
							Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("The flag --" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName String -> ShowS
forall a. [a] -> [a] -> [a]
++ " requires a parameter.")
							Just value :: String
value -> [OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> String -> Token
Token ("--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName) String
value)

parseShort :: Char -> String -> Tok ()
parseShort :: Char -> String -> Tok ()
parseShort optChar :: Char
optChar optValue :: String
optValue = do
	let optName :: String
optName = '-' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char
optChar]
	Map Char ([OptionKey], OptionInfo)
shortKeys <- (StateType Tok -> Map Char ([OptionKey], OptionInfo))
-> Tok (Map Char ([OptionKey], OptionInfo))
forall (m :: * -> *) a. MonadState m => (StateType m -> a) -> m a
gets StateType Tok -> Map Char ([OptionKey], OptionInfo)
TokState -> Map Char ([OptionKey], OptionInfo)
stShortKeys
	case Char
-> Map Char ([OptionKey], OptionInfo)
-> Maybe ([OptionKey], OptionInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Char
optChar Map Char ([OptionKey], OptionInfo)
shortKeys of
		Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("Unknown flag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName)
		Just (keys :: [OptionKey]
keys, info :: OptionInfo
info) -> if OptionInfo -> Bool
optionInfoUnary OptionInfo
info
			-- don't check optionInfoUnaryOnly, because that's only set by --help
			-- options and they define no short flags.
			then do
				[OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> Token
TokenUnary String
optName)
				case String
optValue of
					[] -> () -> Tok ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
					nextChar :: Char
nextChar:nextValue :: String
nextValue -> Char -> String -> Tok ()
parseShort Char
nextChar String
nextValue
			else case String
optValue of
				"" -> do
					Maybe String
next <- Tok (Maybe String)
nextItem
					case Maybe String
next of
						Nothing -> String -> Tok ()
forall a. String -> Tok a
throwError ("The flag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
optName String -> ShowS
forall a. [a] -> [a] -> [a]
++ " requires a parameter.")
						Just value :: String
value -> [OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> String -> Token
Token String
optName String
value)
				_ -> [OptionKey] -> Token -> Tok ()
addOpt [OptionKey]
keys (String -> String -> Token
Token String
optName String
optValue)

toShortKeys :: [OptionInfo] -> Data.Map.Map Char ([OptionKey], OptionInfo)
toShortKeys :: [OptionInfo] -> Map Char ([OptionKey], OptionInfo)
toShortKeys opts :: [OptionInfo]
opts = (([OptionKey], OptionInfo)
 -> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo))
-> [(Char, ([OptionKey], OptionInfo))]
-> Map Char ([OptionKey], OptionInfo)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Data.Map.fromListWith (\(keys1 :: [OptionKey]
keys1, info :: OptionInfo
info) (keys2 :: [OptionKey]
keys2, _) -> ([OptionKey]
keys2 [OptionKey] -> [OptionKey] -> [OptionKey]
forall a. [a] -> [a] -> [a]
++ [OptionKey]
keys1, OptionInfo
info)) ([(Char, ([OptionKey], OptionInfo))]
 -> Map Char ([OptionKey], OptionInfo))
-> [(Char, ([OptionKey], OptionInfo))]
-> Map Char ([OptionKey], OptionInfo)
forall a b. (a -> b) -> a -> b
$ do
	OptionInfo
opt <- [OptionInfo]
opts
	Char
flag <- OptionInfo -> String
optionInfoShortFlags OptionInfo
opt
	(Char, ([OptionKey], OptionInfo))
-> [(Char, ([OptionKey], OptionInfo))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
flag, ([OptionInfo -> OptionKey
optionInfoKey OptionInfo
opt], OptionInfo
opt))

toLongKeys :: [OptionInfo] -> Data.Map.Map String ([OptionKey], OptionInfo)
toLongKeys :: [OptionInfo] -> Map String ([OptionKey], OptionInfo)
toLongKeys opts :: [OptionInfo]
opts = (([OptionKey], OptionInfo)
 -> ([OptionKey], OptionInfo) -> ([OptionKey], OptionInfo))
-> [(String, ([OptionKey], OptionInfo))]
-> Map String ([OptionKey], OptionInfo)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Data.Map.fromListWith (\(keys1 :: [OptionKey]
keys1, info :: OptionInfo
info) (keys2 :: [OptionKey]
keys2, _) -> ([OptionKey]
keys2 [OptionKey] -> [OptionKey] -> [OptionKey]
forall a. [a] -> [a] -> [a]
++ [OptionKey]
keys1, OptionInfo
info)) ([(String, ([OptionKey], OptionInfo))]
 -> Map String ([OptionKey], OptionInfo))
-> [(String, ([OptionKey], OptionInfo))]
-> Map String ([OptionKey], OptionInfo)
forall a b. (a -> b) -> a -> b
$ do
	OptionInfo
opt <- [OptionInfo]
opts
	String
flag <- OptionInfo -> [String]
optionInfoLongFlags OptionInfo
opt
	(String, ([OptionKey], OptionInfo))
-> [(String, ([OptionKey], OptionInfo))]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
flag, ([OptionInfo -> OptionKey
optionInfoKey OptionInfo
opt], OptionInfo
opt))

throwError :: String -> Tok a
throwError :: String -> Tok a
throwError = ErrorT String (StateT TokState Identity) a -> Tok a
forall a. ErrorT String (StateT TokState Identity) a -> Tok a
Tok (ErrorT String (StateT TokState Identity) a -> Tok a)
-> (String -> ErrorT String (StateT TokState Identity) a)
-> String
-> Tok a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorT String (StateT TokState Identity) a
forall (m :: * -> *) a. MonadError m => ErrorType m -> m a
Control.Monad.Error.throwError