Options.hs

{-
	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@]	Static tests.
-}

module BishBosh.Test.HUnit.Input.Options(
-- * Constants
	testCases
) where

--import		BishBosh.Data.Ratio()	-- Required if either Type.Mass.CriterionWeight or Type.Mass.CriterionValue is Rational.
import			Control.Category((>>>))
import qualified	BishBosh.Data.Exception	as Data.Exception
import qualified	BishBosh.Input.Options	as Input.Options
import qualified	BishBosh.Type.Length	as Type.Length
import qualified	BishBosh.Type.Mass	as Type.Mass
import qualified	Control.Exception
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Paths_bishbosh		as Paths	-- Either local stub, or package-instance auto-generated by 'Setup build'.
import qualified	System.Environment
import qualified	System.FilePath
import qualified	Test.HUnit
import qualified	Text.XML.HXT.Core	as HXT
import qualified	ToolShed.System.File
import			System.FilePath((</>), (<.>))
import			Test.HUnit((@?))

-- | Check the sanity of the implementation, by validating a list of static test-cases.
testCases :: Test.HUnit.Test
testCases	= Test.HUnit.test [
	Test.HUnit.TestCase $ let
		inputSysConfig :: HXT.SysConfigList
		inputSysConfig	= [
			HXT.withRemoveWS	HXT.yes,	-- Remove white-space, e.g. any indentation which might have been introduced by 'HXT.withIndent'.
			HXT.withStrictInput	HXT.yes,	-- Read the input file strictly (cf. lazily), this ensures closing the files correctly even if not read completely.
			HXT.withValidate	HXT.yes		-- Validate against any DTD referenced from the XML-file.
		 ]

		fileName :: System.FilePath.FilePath
		fileName	= "bishbosh_both" <.> "xml"
	in do
		dataDir		<- fmap System.FilePath.normalise Paths.getDataDir
		executablePath	<- fmap System.FilePath.normalise System.Environment.getExecutablePath

		let
			searchPath	= Data.List.nub . map (</> "config" </> "Raw") $ [
				".",
				dataDir	-- The installation-directory.
			 ] ++ Data.List.unfoldr (
				\filePath -> let
					directory	= System.FilePath.takeDirectory filePath
				in if directory `elem` map return {-to List-monad-} ['.', System.FilePath.pathSeparator]
					then Nothing
					else Just (directory, directory)
			 ) executablePath
		 in ToolShed.System.File.locate fileName searchPath >>= Data.Maybe.maybe (
			Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.Test.HUnit.Input.Options.testCases:\tfailed to locate " . shows fileName . showString " in " $ shows searchPath "."
		 ) (
			\path -> do
				optionsList	<- HXT.runX {-which returns a list-} $ HXT.setTraceLevel 0 >>> HXT.xunpickleDocument HXT.xpickle inputSysConfig path

				(== Just (head optionsList)) (
					(HXT.unpickleDoc HXT.xpickle . HXT.pickleDoc HXT.xpickle) =<< Data.Maybe.listToMaybe (
						optionsList :: [
							Input.Options.Options Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y
						]
					)
				 ) @? "Input.Options.pickler failed."
		 ) . Data.Maybe.listToMaybe
 ]