bishbosh 0.0.0.5 → 0.0.0.6

raw patch · 19 files changed

+104/−56 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bishbosh.cabal +1/−1
• bishbosh.spec +1/−1
• changelog.markdown +5/−0
• config/CECP/bishbosh_black.xml +2/−2
• config/Raw/bishbosh_black.xml +3/−2
• config/Raw/bishbosh_prof.xml +1/−1
• config/bishbosh.dtd +1/−1
• config/bishbosh.rng +1/−1
• src-exe/BishBosh/UI/CECP.hs +16/−3
• src-exe/BishBosh/UI/Raw.hs +22/−12
• src-exe/Main.hs +1/−2
• src-lib/BishBosh/Input/IOOptions.hs +2/−2
• src-lib/BishBosh/Input/Options.hs +2/−2
• src-lib/BishBosh/Input/UIOptions.hs +2/−3
• src-lib/BishBosh/Input/Verbosity.hs +23/−8
• src-lib/BishBosh/Text/Encoding.hs +14/−7
• src-lib/BishBosh/UI/Command.hs +3/−3
• src-test/BishBosh/Test/QuickCheck/Input/Verbosity.hs +1/−2
• src-test/BishBosh/Test/QuickCheck/Text/Encoding.hs +3/−3

@@ -14,7 +14,7 @@ -- along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.  Name:		bishbosh-Version:	0.0.0.5+Version:	0.0.0.6 Cabal-version:	>= 1.10 Copyright:	(C) 2018 Dr. Alistair Ward License:	GPL

@@ -24,7 +24,7 @@  Summary:	BishBosh is a chess-game. Name:		bishbosh-Version:	0.0.0.5+Version:	0.0.0.6 Release:	1 License:	GPLv3 # From '/usr/share/doc/packages/rpm/GROUPS'.

@@ -15,3 +15,8 @@ ## 0.0.0.5 Added ability to specify the text-encoding used in a PGN-database file. Updated list of test-compilers.++## 0.0.0.6+Fixed failure to persist game-state after requesting that the game be restarted.+Fixed parsing of **TextEncoding** in **PGNOptions**.+Replaced module **Distribution.Verbosity** with **BishBosh.Input.Verbosity**.

@@ -52,10 +52,10 @@ 			<identificationTag tag="ECO"/> 			<identificationTag tag="Variation"/> <!---		</pgnOptions><pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="False" textEncoding="ISO8859-1">+		</pgnOptions><pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="False" textEncoding="ISO-8859-1"> 			<identificationTag tag="ECO"/> 			<identificationTag tag="Variation"/>-		</pgnOptions><pgnOptions databaseFilePath="pgn/bundesliga2000.pgn" validateMoves="False" textEncoding="ISO8859-1">+		</pgnOptions><pgnOptions databaseFilePath="pgn/bundesliga2000.pgn" validateMoves="False" textEncoding="ISO-8859-1"> 			<identificationTag tag="Event"/> 			<identificationTag tag="Round"/> 		</pgnOptions><pgnOptions databaseFilePath="pgn/ficsgamesdb_201601_standard2000_nomovetimes_1403205.pgn" validateMoves="False" minimumPlies="8">

@@ -53,10 +53,11 @@ 			<identificationTag tag="Variation"/> 		</pgnOptions> <!---		<pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="False" textEncoding="ISO8859-1">+		<pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="False" textEncoding="ISO-8859-1"> 			<identificationTag tag="ECO"/> 			<identificationTag tag="Variation"/>-		</pgnOptions><pgnOptions databaseFilePath="pgn/bundesliga2000.pgn" validateMoves="False" textEncoding="ISO8859-1">+		</pgnOptions>+		<pgnOptions databaseFilePath="pgn/bundesliga2000.pgn" validateMoves="False" textEncoding="ISO-8859-1"> 			<identificationTag tag="Event"/> 			<identificationTag tag="Round"/> 		</pgnOptions><pgnOptions databaseFilePath="pgn/ficsgamesdb_201601_standard2000_nomovetimes_1403205.pgn" validateMoves="False" minimumPlies="8">

@@ -56,7 +56,7 @@ 		</searchDepthByLogicalColour> 	</searchOptions> 	<ioOptions maximumPGNNames="8">-		<pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="True" textEncoding="ISO8859-1">+		<pgnOptions databaseFilePath="pgn/scid_fr.pgn" validateMoves="True" textEncoding="ISO-8859-1"> 			<identificationTag tag="ECO"/> 			<identificationTag tag="Variation"/> 		</pgnOptions>

@@ -96,7 +96,7 @@ 				minimumPlies		CDATA					#IMPLIED 				isStrictlySequential	(False | True)				#IMPLIED 				validateMoves		(False | True)				#IMPLIED-				textEncoding		(ISO8859-1 | UTF-8 | UTF-16 | UTF-32)	#IMPLIED+				textEncoding		(ISO-8859-1 | UTF-8 | UTF-16 | UTF-32)	#IMPLIED 			> 			<!ELEMENT identificationTag EMPTY> 				<!ATTLIST identificationTag

@@ -155,7 +155,7 @@ 							<optional> 								<attribute name="textEncoding"> 									<choice>-										<value>ISO8859-1</value>+										<value>ISO-8859-1</value> 										<value>UTF-8</value> 										<value>UTF-16</value> 										<value>UTF-32</value>

@@ -315,7 +315,20 @@ 						else showString " & leaving " . shows modeNames 				 ) "." -				return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree Data.Default.def {-game-} playState {+				let game''	= Data.Default.def++				Data.Maybe.maybe (+					return {-to IO-monad-} ()+				 ) (+					\(filePath, _) -> Control.Exception.catch (+						do+							System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')++							Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowList.showsInfoPrefix . showString "the game-state has been saved in " $ shows filePath "."+					) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowList.showsErrorPrefix $ show (e :: Control.Exception.SomeException)+				 ) $ Input.IOOptions.getMaybePersistence ioOptions++				return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree game'' playState { 					State.PlayState.getOptions	= options { 						Input.Options.getIOOptions	= ioOptions { 							Input.IOOptions.getUIOptions	= uiOptions {@@ -323,7 +336,7 @@ 							} 						} 					}-				}	-- By exiting the event-loop, the new game will be persisted where appropriate.+				} 			onCommand (UI.Command.RollBack maybeNPlies)	= let 				rollBack :: Component.Move.NMoves -> IO (State.PlayState.PlayState column criterionValue criterionWeight pieceSquareValue positionHash rankValue row weightedMean x y) 				rollBack nPlies@@ -1262,7 +1275,7 @@ 						 ) ( 							\(filePath, automatic) -> let 								game''	= State.PlayState.getGame playState''-							in Control.Monad.when (automatic && show game'' /= show game') . Control.Exception.catch (+							in Control.Monad.when automatic . Control.Exception.catch ( 								System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'') 							) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowList.showsErrorPrefix $ show (e :: Control.Exception.SomeException) 						 ) $ Input.IOOptions.getMaybePersistence ioOptions

@@ -52,7 +52,6 @@ import qualified	BishBosh.Model.Game						as Model.Game import qualified	BishBosh.Notation.MoveNotation					as Notation.MoveNotation import qualified	BishBosh.Property.ForsythEdwards				as Property.ForsythEdwards-import qualified	BishBosh.Property.Null						as Property.Null import qualified	BishBosh.Property.ShowFloat					as Property.ShowFloat import qualified	BishBosh.Search.Search						as Search.Search import qualified	BishBosh.Search.SearchState					as Search.SearchState@@ -207,23 +206,31 @@ 				UI.PrintObject.PGN		-> ContextualNotation.PGN.showsGame game >>= putStrLn . ($ "")  			eventLoop-		onCommand UI.Command.Quit		= do+		onCommand UI.Command.Quit	= do 			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.Show.showsInfoPrefix "quitting on request."  			return {-to IO-monad-} playState { State.PlayState.getMaybeApplicationTerminationReason = Just State.ApplicationTerminationReason.byRequest }-		onCommand UI.Command.Resign		= do+		onCommand UI.Command.Resign	= do 			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.Show.showsInfoPrefix "resigning."  			return {-to IO-monad-} $ State.PlayState.resign playState-		onCommand UI.Command.Restart-			| Property.Null.isNull game	= do-				Control.Monad.when (verbosity >= Data.Default.def) . System.IO.hPutStrLn System.IO.stderr $ Text.Show.showsWarningPrefix "the game is unstarted."+		onCommand UI.Command.Restart	= do+			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.Show.showsInfoPrefix "restarting game." -				return {-to IO-monad-} playState-			| otherwise			= do-				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.Show.showsInfoPrefix "restarting game."+			let game''	= Data.Default.def -				return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree Data.Default.def {-game-} playState	-- By exiting the event-loop, the new game will be persisted where appropriate.+			Data.Maybe.maybe (+				return {-to IO-monad-} ()+			 ) (+				\(filePath, _) -> Control.Exception.catch (+					do+						System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')++						Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.Show.showsInfoPrefix . showString "the game-state has been saved in " $ shows filePath "."+				) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.Show.showsErrorPrefix $ show (e :: Control.Exception.SomeException)+			 ) $ Input.IOOptions.getMaybePersistence ioOptions++			return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree game'' playState 		onCommand (UI.Command.RollBack maybeNPlies)	= let 			rollBack :: Component.Move.NMoves -> IO (State.PlayState.PlayState column criterionValue criterionWeight pieceSquareValue positionHash rankValue row weightedMean x y) 			rollBack nPlies@@ -577,8 +584,11 @@ 							 ) ( 								\(filePath, automatic) -> let 									game''	= State.PlayState.getGame playState''-								in Control.Monad.when (automatic && show game'' /= show game') . Control.Exception.catch (-									System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')+								in Control.Monad.when automatic . Control.Exception.catch (+									do+										System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')++										Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.Show.showsInfoPrefix . showString "the game-state has been saved in " $ shows filePath "." 								) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.Show.showsErrorPrefix $ show (e :: Control.Exception.SomeException) 							 ) $ Input.IOOptions.getMaybePersistence ioOptions 

@@ -59,7 +59,6 @@ import qualified	Data.List import qualified	Data.Maybe import qualified	Data.Version-import qualified	Distribution.Verbosity import qualified	Paths_bishbosh					as Paths	-- Either local stub, or package-instance auto-generated by 'Setup build'. import qualified	System.Console.GetOpt				as G import qualified	System.Directory@@ -269,7 +268,7 @@ 	but regrettably "verbosity" (a command-line option) is needed while doing so. 	This is resolved by reading the "verbosity" from the command-line first. -}-					preVerbosity :: Distribution.Verbosity.Verbosity+					preVerbosity :: Input.Verbosity.Verbosity 					preVerbosity 						| null verbosityArgs	= Data.Default.def 						| otherwise		= Input.CommandLineOption.readArg $ head verbosityArgs

@@ -59,6 +59,7 @@ import qualified	BishBosh.Input.CECPFeatures	as Input.CECPFeatures import qualified	BishBosh.Input.PGNOptions	as Input.PGNOptions import qualified	BishBosh.Input.UIOptions	as Input.UIOptions+import qualified	BishBosh.Input.Verbosity	as Input.Verbosity import qualified	BishBosh.Property.Tree		as Property.Tree import qualified	BishBosh.Text.ShowList		as Text.ShowList import qualified	Control.Arrow@@ -66,7 +67,6 @@ import qualified	Control.Exception import qualified	Data.Default import qualified	Data.Maybe-import qualified	Distribution.Verbosity import qualified	System.FilePath import qualified	Text.XML.HXT.Arrow.Pickle	as HXT import qualified	ToolShed.Data.Foldable@@ -261,7 +261,7 @@ }  -- | Mutator.-setVerbosity :: Distribution.Verbosity.Verbosity -> Transformation row column+setVerbosity :: Input.Verbosity.Verbosity -> Transformation row column setVerbosity verbosity ioOptions@MkIOOptions { getUIOptions = uiOptions }	= ioOptions { 	getUIOptions	= uiOptions { 		Input.UIOptions.getVerbosity	= verbosity

@@ -61,6 +61,7 @@ import qualified	BishBosh.Input.IOOptions		as Input.IOOptions import qualified	BishBosh.Input.SearchOptions		as Input.SearchOptions import qualified	BishBosh.Input.UIOptions		as Input.UIOptions+import qualified	BishBosh.Input.Verbosity		as Input.Verbosity import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat import qualified	BishBosh.Property.Tree			as Property.Tree import qualified	BishBosh.Text.ShowList			as Text.ShowList@@ -68,7 +69,6 @@ import qualified	Control.Exception import qualified	Data.Default import qualified	Data.Maybe-import qualified	Distribution.Verbosity import qualified	System.FilePath import qualified	Text.XML.HXT.Arrow.Pickle		as HXT @@ -252,7 +252,7 @@ }  -- | Mutator.-setVerbosity :: Distribution.Verbosity.Verbosity -> Transformation column criterionWeight pieceSquareValue rankValue row x y+setVerbosity :: Input.Verbosity.Verbosity -> Transformation column criterionWeight pieceSquareValue rankValue row x y setVerbosity verbosity options@MkOptions { getIOOptions = ioOptions }	= options { 	getIOOptions	= Input.IOOptions.setVerbosity verbosity ioOptions }

@@ -67,7 +67,6 @@ import qualified	Control.Exception import qualified	Data.Default import qualified	Data.Maybe-import qualified	Distribution.Verbosity import qualified	Text.XML.HXT.Arrow.Pickle	as HXT  -- | Used to qualify XML.@@ -99,7 +98,7 @@ 	getMaybePrintMoveTree		:: Maybe Property.Tree.Depth,			-- ^ Print the move-tree to the specified depth. 	getNDecimalDigits		:: Property.ShowFloat.NDecimalDigits,		-- ^ The precision to which fractional auxiliary data is displayed. 	getEitherNativeUIOrCECPOptions	:: EitherNativeUIOrCECPOptions row column,	-- ^ When a native display is configured some additional style-parameters are required.-	getVerbosity			:: Distribution.Verbosity.Verbosity		-- ^ Set the threshold for ancillary information-output.+	getVerbosity			:: Input.Verbosity.Verbosity			-- ^ Set the threshold for ancillary information-output. } deriving Eq  instance (@@ -196,7 +195,7 @@ 	-> Maybe Property.Tree.Depth 	-> Property.ShowFloat.NDecimalDigits	-- ^ The precision to which fractional auxiliary data is displayed. 	-> EitherNativeUIOrCECPOptions row column-	-> Distribution.Verbosity.Verbosity	-- ^ Set the threshold for logging.+	-> Input.Verbosity.Verbosity		-- ^ Set the threshold for logging. 	-> UIOptions row column mkUIOptions moveNotation maybePrintMoveTree nDecimalDigits eitherNativeUIOrCECPOptions verbosity 	| Just depth <- maybePrintMoveTree

@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -20,10 +19,15 @@ {- |  [@AUTHOR@]	Dr. Alistair Ward - [@DESCRIPTION@]	Instance-definitions for 'Distribution.Verbosity.Verbosity'.+ [@DESCRIPTION@]+	The levels of program-output.+	N.B.: the data-type is coincidentally similar to 'Distribution.Verbosity.Internal.VerbosityLevel'. -}  module BishBosh.Input.Verbosity(+-- * Types+-- ** Data-types+	Verbosity(), -- * Constants 	tag, 	range@@ -31,7 +35,6 @@  import qualified	Control.DeepSeq import qualified	Data.Default-import qualified	Distribution.Verbosity import qualified	Text.XML.HXT.Arrow.Pickle	as HXT import qualified	Text.XML.HXT.Arrow.Pickle.Schema @@ -39,16 +42,28 @@ tag :: String tag	= "verbosity" -instance Data.Default.Default Distribution.Verbosity.Verbosity where-	def	= Distribution.Verbosity.normal+-- | Define the levels of program-output.+data Verbosity+	= Silent+	| Normal+	| Verbose+	| Deafening+	deriving (Enum, Eq, Ord, Read, Show) -instance HXT.XmlPickler Distribution.Verbosity.Verbosity where+instance Bounded Verbosity where+	minBound	= Silent+	maxBound	= Deafening++instance Data.Default.Default Verbosity where+	def	= Normal++instance HXT.XmlPickler Verbosity where 	xpickle	= HXT.xpWrap (read, show) . HXT.xpAttr tag . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range	-- CAVEAT: whether it'll be used as an XML-attribute or an XML-element isn't currently known. -instance Control.DeepSeq.NFData Distribution.Verbosity.Verbosity where+instance Control.DeepSeq.NFData Verbosity where 	rnf _	= ()  -- | The constant complete range of values.-range :: [Distribution.Verbosity.Verbosity]+range :: [Verbosity] range	= [minBound .. maxBound] 

@@ -43,13 +43,20 @@  instance Read System.IO.TextEncoding where 	readsPrec _ s	= case Data.List.Extra.trimStart s of-		'I':'S':'O':'8':'8':'5':'9':'-':'1':remainder	-> return {-to List-monad-} . (,) System.IO.latin1 $ case remainder of-			'(':'c':'h':'e':'c':'k':'e':'d':')':remainder2	-> remainder2	-- Junk.-			_						-> remainder-		'U':'T':'F':'-':'8':remainder			-> [(System.IO.utf8, remainder)]-		'U':'T':'F':'-':'1':'6':remainder		-> [(System.IO.utf16, remainder)]-		'U':'T':'F':'-':'3':'2':remainder		-> [(System.IO.utf32, remainder)]-		_						-> []	-- No parse.+		'I':'S':'O':remainder -> case remainder of+			'8':'8':'5':'9':'-':'1':remainder2	-> return {-to List-monad-} . (,) System.IO.latin1 $ case remainder2 of+				'(':'c':'h':'e':'c':'k':'e':'d':')':remainder3	-> remainder3+				_						-> remainder2+			'-':'8':'8':'5':'9':'-':'1':remainder2	-> return {-to List-monad-} . (,) System.IO.latin1 $ case remainder2 of+				'(':'c':'h':'e':'c':'k':'e':'d':')':remainder3	-> remainder3+				_						-> remainder2+			_					-> []	-- No parse.+		'U':'T':'F':'-':remainder -> case remainder of+			'8':remainder2		-> [(System.IO.utf8, remainder2)]+			'1':'6':remainder2	-> [(System.IO.utf16, remainder2)]+			'3':'2':remainder2	-> [(System.IO.utf32, remainder2)]+			_			-> []	-- No parse.+		_	-> []	-- No parse.  instance HXT.XmlPickler System.IO.TextEncoding where 	xpickle	= HXT.xpDefault Data.Default.def . HXT.xpWrap (read, show) . HXT.xpAttr tag . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range

@@ -147,11 +147,11 @@ 	), ( 		quitTag, 		Nothing,-		"Quit"+		"Terminate ths application" 	), ( 		resignTag, 		Nothing,-		"Resign"+		"Admit defeat" 	), ( 		restartTag, 		Nothing,@@ -163,7 +163,7 @@ 	), ( 		saveTag, 		Nothing,-		"Save"+		"Persist the current game-state" 	), ( 		setTag, 		Just setArgs,

@@ -26,8 +26,7 @@ module BishBosh.Test.QuickCheck.Input.Verbosity() where  import qualified	BishBosh.Input.Verbosity	as Input.Verbosity-import qualified	Distribution.Verbosity import qualified	Test.QuickCheck -instance Test.QuickCheck.Arbitrary Distribution.Verbosity.Verbosity where+instance Test.QuickCheck.Arbitrary Input.Verbosity.Verbosity where 	arbitrary	= Test.QuickCheck.elements Input.Verbosity.range

@@ -42,16 +42,16 @@ 	let 		f :: System.IO.TextEncoding -> Test.QuickCheck.Property 		f	= Test.QuickCheck.label "Text.Encoding.prop_readPrependedWhiteSpace" . ToolShed.Test.ReversibleIO.readPrependedWhiteSpace-	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 256 } f,+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 1024 } f, 	let 		f :: String -> Test.QuickCheck.Property 		f garbage	= Test.QuickCheck.label "Text.Encoding.prop_read" $ case (reads garbage :: [(System.IO.TextEncoding, String)]) of 			[_]	-> True 			_	-> True	-- Unless the read-implementation throws an exception.-	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 256 } f,+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 1024 } f, 	let 		f :: System.IO.TextEncoding -> String -> Test.QuickCheck.Property 		f textEncoding	= Test.QuickCheck.label "Text.Encoding.prop_readTrailingGarbage" . ToolShed.Test.ReversibleIO.readTrailingGarbage (const False) textEncoding-	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 256 } f+	in Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 1024 } f  ]