{-# 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@]	Defines the commands a user can issue.
-}

module BishBosh.UI.Command (
-- * Types
-- ** Data-types
	Command(..),
-- * Constants
--	commandPrefix,
--	hintTag,
	printTag,
--	quitTag,
--	reportTag,
--	resignTag,
--	restartTag,
--	rollBackTag,
--	saveTag,
	setTag,
--	swapTag,
--	alternationTag,
--	printArgs,
--	reportArgs,
--	setArgs,
--	commands,
	usageMessage,
-- * Functions
	readsCommand,
	showsCommand,
	issueCommand,
	autoComplete
 ) where

import qualified	BishBosh.Data.List
import qualified	BishBosh.Input.Options				as Input.Options
import qualified	BishBosh.Property.ExtendedPositionDescription	as Property.ExtendedPositionDescription
import qualified	BishBosh.Text.AutoComplete			as Text.AutoComplete
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	BishBosh.UI.PrintObject				as UI.PrintObject
import qualified	BishBosh.UI.ReportObject			as UI.ReportObject
import qualified	BishBosh.UI.SetObject				as UI.SetObject
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Maybe
import qualified	Text.Printf

-- | Used to distinguish a command from a move.
commandPrefix :: Char
commandPrefix :: Char
commandPrefix	= Char
':'

-- | Input-format.
hintTag :: String
hintTag :: String
hintTag		= String
"hint"

-- | Input-format.
printTag :: String
printTag :: String
printTag	= String
"print"

-- | Input-format.
quitTag :: String
quitTag :: String
quitTag		= String
"quit"

-- | Input-format.
reportTag :: String
reportTag :: String
reportTag	= String
"report"

-- | Input-format.
resignTag :: String
resignTag :: String
resignTag	= String
"resign"

-- | Input-format.
restartTag :: String
restartTag :: String
restartTag	= String
"restart"

-- | Input-format.
rollBackTag :: String
rollBackTag :: String
rollBackTag	= String
"rollBack"

-- | Input-format.
saveTag :: String
saveTag :: String
saveTag		= String
"save"

-- | Input-format.
setTag :: String
setTag :: String
setTag		= String
"set"

-- | Input-format.
swapTag :: String
swapTag :: String
swapTag		= String
"swap"

-- | The symbol used to denote alternation.
alternationTag :: String
alternationTag :: String
alternationTag	= String
"|"

-- | Show the arguments of a command.
printArgs :: String
printArgs :: String
printArgs	= String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate String
alternationTag ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PrintObject -> String) -> [PrintObject] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PrintObject -> String
forall a. Show a => a -> String
show [PrintObject]
UI.PrintObject.range

-- | Show the arguments of a command.
reportArgs :: String
reportArgs :: String
reportArgs	= String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate String
alternationTag ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (ReportObject -> String) -> [ReportObject] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ReportObject -> String
forall a. Show a => a -> String
show [ReportObject]
UI.ReportObject.range

-- | The format of the argument to the runtime-command /set/.
setArgs :: String
setArgs :: String
setArgs	= String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate String
alternationTag [
	String -> ShowS
showString String
Property.ExtendedPositionDescription.tag String
" <EPD>",
	String -> ShowS
showString String
UI.SetObject.searchDepthTag String
" <Int>"
 ]

-- | The sum-type of commands that a user may issue.
data Command
	= Hint					-- ^ Request a move-suggestion.
	| Print UI.PrintObject.PrintObject	-- ^ Print the requested static data.
	| Quit					-- ^ Terminate this application.
	| Report UI.ReportObject.ReportObject	-- ^ Report on the requested dynamic data.
	| Resign				-- ^ Admit defeat.
	| Restart				-- ^ Abandon the current game, & start afresh.
	| RollBack (Maybe Type.Count.NPlies)	-- ^ Roll-back the optionally specified number of plies.
	| Save					-- ^ Persist the current game-state.
	| Set UI.SetObject.SetObject		-- ^ I.E. mutate something.
	| Swap					-- ^ Swap options between the two sides; which causes the players to swap sides.
	deriving (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

instance Control.DeepSeq.NFData Command where
	rnf :: Command -> ()
rnf (Print PrintObject
printObject)	= PrintObject -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf PrintObject
printObject
	rnf (Set SetObject
setObject)	= SetObject -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf SetObject
setObject
	rnf Command
_			= ()

-- | The data required to compose the usage-message for the available /command/s.
commands :: [(String, Maybe String, String)]
commands :: [(String, Maybe String, String)]
commands	= [
	(
		String
hintTag,
		Maybe String
forall a. Maybe a
Nothing,
		String
"Request a move-suggestion"
	), (
		String
printTag,
		String -> Maybe String
forall a. a -> Maybe a
Just String
printArgs,
		String
"Print the specified static data"
	), (
		String
quitTag,
		Maybe String
forall a. Maybe a
Nothing,
		String
"Terminate this application"
	), (
		String
reportTag,
		String -> Maybe String
forall a. a -> Maybe a
Just String
reportArgs,
		String
"Report on the specified dynamic data"
	), (
		String
resignTag,
		Maybe String
forall a. Maybe a
Nothing,
		String
"Admit defeat"
	), (
		String
restartTag,
		Maybe String
forall a. Maybe a
Nothing,
		String
"Restart the game, preserving the current configuration"
	), (
		String
rollBackTag,
		String -> Maybe String
forall a. a -> Maybe a
Just String
"[<Int>]",
		String
"The optionally specified number of plies to roll-back"
	), (
		String
saveTag,
		Maybe String
forall a. Maybe a
Nothing,
		String
"Persist the current game-state"
	), (
		String
setTag,
		String -> Maybe String
forall a. a -> Maybe a
Just String
setArgs,
		String
"Mutate something"
	), (
		String
swapTag,
		Maybe String
forall a. Maybe a
Nothing,
		String -> ShowS
showString String
"Swap " ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.Options.tag String
" between the two sides"
	)
 ]

-- | A message defining the syntax of the available /command/s.
usageMessage :: String
usageMessage :: String
usageMessage	= String -> ShowS
showString (
	String -> Int -> String -> Int -> String -> ShowS
forall r. PrintfType r => String -> r
Text.Printf.printf (String -> ShowS
showString String
indent ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
' ' String
format) Int
commandFieldWidth String
"Command" Int
objectFieldWidth String
"Object" String
"Definition"
 ) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((String, Maybe String, String) -> String)
-> [(String, Maybe String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (
	\(String
command, Maybe String
maybeArg, String
definition)	-> String -> Int -> String -> Int -> String -> ShowS
forall r. PrintfType r => String -> r
Text.Printf.printf (
		Char -> ShowS
showChar Char
'\n' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
indent ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
commandPrefix ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
format String
"."
	) Int
commandFieldWidth String
command Int
objectFieldWidth (
		String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe String
"" Maybe String
maybeArg
	) String
definition
 ) [(String, Maybe String, String)]
commands where
	indent, format :: String
	indent :: String
indent	= Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
2 Char
' '
	format :: String
format	= String
"%-*s%-*s%s"

	commandFieldWidth, objectFieldWidth :: Int
	commandFieldWidth :: Int
commandFieldWidth	= Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Maybe String, String) -> Int)
-> [(String, Maybe String, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
tag, Maybe String
_, String
_) -> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tag) [(String, Maybe String, String)]
commands
	objectFieldWidth :: Int
objectFieldWidth	= Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
arg | (String
_, Just String
arg, String
_) <- [(String, Maybe String, String)]
commands]

-- | Reads a /command/.
readsCommand :: String -> Either String (Command, String)
readsCommand :: String -> Either String (Command, String)
readsCommand []	= String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ([String] -> String)
-> [String]
-> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"null command received; specify one of " ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Show a => a -> String
show ([String] -> Either String (Command, String))
-> [String] -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ ((String, Maybe String, String) -> String)
-> [(String, Maybe String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
tag, Maybe String
_, String
_) -> String
tag) [(String, Maybe String, String)]
commands
readsCommand String
s	= case ShowS -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ShowS
Data.List.Extra.lower ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS String
lex String
s of
	[(String
"hint", String
s')]		-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Hint, String
s')
	[(String
"help", String
s')]		-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (PrintObject -> Command
Print PrintObject
UI.PrintObject.Help, String
s')	-- Include a specific abbreviation.
	[(String
"print", String
s')]		-> case ReadS PrintObject
forall a. Read a => ReadS a
reads ReadS PrintObject -> ReadS PrintObject
forall a b. (a -> b) -> a -> b
$ ShowS
UI.PrintObject.autoComplete String
s' of
		[(PrintObject, String)
pair]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right ((Command, String) -> Either String (Command, String))
-> (Command, String) -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ (PrintObject -> Command)
-> (PrintObject, String) -> (Command, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first PrintObject -> Command
Print (PrintObject, String)
pair
		[(PrintObject, String)]
_	-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ShowS -> String -> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to read the object to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
printTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" from " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
s' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Usage: \"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
commandPrefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
printTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' (String -> Either String (Command, String))
-> String -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
printArgs String
"\""
	[(String
"quit", String
s')]		-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Quit, String
s')
	[(String
"report", String
s')]	-> case ReadS ReportObject
forall a. Read a => ReadS a
reads ReadS ReportObject -> ReadS ReportObject
forall a b. (a -> b) -> a -> b
$ ShowS
UI.ReportObject.autoComplete String
s' of
		[(ReportObject, String)
pair]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right ((Command, String) -> Either String (Command, String))
-> (Command, String) -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ (ReportObject -> Command)
-> (ReportObject, String) -> (Command, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ReportObject -> Command
Report (ReportObject, String)
pair
		[(ReportObject, String)]
_	-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ShowS -> String -> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to read the object to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
reportTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" from " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
s' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Usage: \"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
commandPrefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
reportTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' (String -> Either String (Command, String))
-> String -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
reportArgs String
"\""
	[(String
"resign", String
s')]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Resign, String
s')
	[(String
"restart", String
s')]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Restart, String
s')
	[(String
"save", String
s')]		-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Save, String
s')
	[(String
"set", String
s')]		-> case ReadS SetObject
forall a. Read a => ReadS a
reads ReadS SetObject -> ReadS SetObject
forall a b. (a -> b) -> a -> b
$ ShowS
UI.SetObject.autoComplete String
s' of
		[(SetObject, String)
pair]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right ((Command, String) -> Either String (Command, String))
-> (Command, String) -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ (SetObject -> Command) -> (SetObject, String) -> (Command, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first SetObject -> Command
Set (SetObject, String)
pair
		[(SetObject, String)]
_	-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ShowS -> String -> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to read the object to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
setTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" from " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
s' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Usage: \"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
commandPrefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
setTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" (" (String -> Either String (Command, String))
-> String -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
setArgs String
")\""
	[(String
"rollback", String
s')]	-> case ShowS
Data.List.Extra.trimStart String
s' of
		[]	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Maybe Int -> Command
RollBack Maybe Int
forall a. Maybe a
Nothing, String
s')
		String
s''	-> case ReadS Integer
forall a. Read a => ReadS a
reads String
s'' of
			[(Integer
nPlies, String
s''')]
				| Integer
nPlies Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0	-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ShowS -> String -> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"the specified number of plies (" (String -> Either String (Command, String))
-> String -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
nPlies String
") must exceed zero"
				| Bool
otherwise	-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Maybe Int -> Command
RollBack (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
nPlies), String
s''')
			[(Integer, String)]
_			-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ShowS -> String -> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to read the integral number of plies to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
rollBackTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" from " (String -> Either String (Command, String))
-> String -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s''
	[(String
"swap", String
s')]		-> (Command, String) -> Either String (Command, String)
forall a b. b -> Either a b
Right (Command
Swap, String
s')
	(String
command, String
_) : [(String, String)]
_	-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left (String -> Either String (Command, String))
-> ([String] -> String)
-> [String]
-> Either String (Command, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to read a command from " ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
s ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; did you mean " ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Show a => a -> String
show ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. Eq a => [a] -> [[a]] -> [[a]]
BishBosh.Data.List.findClosest String
command ([String] -> Either String (Command, String))
-> [String] -> Either String (Command, String)
forall a b. (a -> b) -> a -> b
$ ((String, Maybe String, String) -> String)
-> [(String, Maybe String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
tag, Maybe String
_, String
_) -> String
tag) [(String, Maybe String, String)]
commands
	[(String, String)]
_			-> String -> Either String (Command, String)
forall a b. a -> Either a b
Left String
"no command received"

-- | Shows a /command/.
showsCommand :: Command -> ShowS
showsCommand :: Command -> ShowS
showsCommand	= \case
	Command
Hint			-> String -> ShowS
showString String
hintTag
	Print PrintObject
printObject	-> String -> ShowS
showString String
printTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintObject -> ShowS
forall a. Show a => a -> ShowS
shows PrintObject
printObject
	Command
Quit			-> String -> ShowS
showString String
quitTag
	Report ReportObject
reportObject	-> String -> ShowS
showString String
reportTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportObject -> ShowS
forall a. Show a => a -> ShowS
shows ReportObject
reportObject
	Command
Resign			-> String -> ShowS
showString String
resignTag
	Command
Restart			-> String -> ShowS
showString String
restartTag
	RollBack Maybe Int
maybeNPlies	-> String -> ShowS
showString String
rollBackTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (Int -> ShowS) -> Maybe Int -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
forall a. a -> a
id (\Int
nPlies -> Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
nPlies) Maybe Int
maybeNPlies
	Command
Save			-> String -> ShowS
showString String
saveTag
	Set SetObject
setObject		-> String -> ShowS
showString String
setTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetObject -> ShowS
forall a. Show a => a -> ShowS
shows SetObject
setObject
	Command
Swap			-> String -> ShowS
showString String
swapTag

-- | Show the specified command in the format required by this application's parser.
issueCommand :: Command -> ShowS
issueCommand :: Command -> ShowS
issueCommand Command
command	= Char -> ShowS
showChar Char
commandPrefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> ShowS
forall a. Show a => a -> ShowS
shows Command
command

-- | Replace the first word of the specified string with the name of a command of which it is an unambiguous case-insensitive prefix.
autoComplete :: ShowS
autoComplete :: ShowS
autoComplete	= [String] -> ShowS
Text.AutoComplete.autoComplete ([String] -> ShowS) -> [String] -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"help" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String, Maybe String, String) -> String)
-> [(String, Maybe String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (
	\(String
tag, Maybe String
_, String
_) -> String
tag
 ) [(String, Maybe String, String)]
commands