{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- Copyright (C) 2012 John Millikin <jmillikin@gmail.com>
--
-- See license.txt for details
module OptionsTests.OptionTypes
	( test_OptionTypes
	) where

import           Data.Int
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import           Data.Word

import qualified Filesystem.Path.Rules as Path
import qualified Filesystem.Path.CurrentOS ()
import           Test.Chell

import           Options.OptionTypes

test_OptionTypes :: Suite
test_OptionTypes = suite "option-types"
	[ test_Bool
	, test_String
	, test_Text
	, test_FilePath
	, test_Int
	, test_Int8
	, test_Int16
	, test_Int32
	, test_Int64
	, test_Word
	, test_Word8
	, test_Word16
	, test_Word32
	, test_Word64
	, test_Integer
	, test_Float
	, test_Double
	, test_Maybe
	, test_List
	, test_Set
	, test_Map
	, test_Enum
	]

parseValid :: (Show a, Eq a) => OptionType a -> String -> a -> Assertion
parseValid t s expected = equal (optionParser t s) (Right expected)

parseInvalid :: (Show a, Eq a) => OptionType a -> String -> String -> Assertion
parseInvalid t s err = equal (optionParser t s) (Left err)

optionParser :: OptionType a -> String -> Either String a
optionParser (OptionType _ _ p _) = p

test_Bool :: Suite
test_Bool = assertions "bool" $ do
	$expect (parseValid optionTypeBool "true" True)
	$expect (parseValid optionTypeBool "false" False)
	$expect (parseInvalid optionTypeBool "" "\"\" is not in {\"true\", \"false\"}.")

test_String :: Suite
test_String = assertions "string" $ do
	let valid = parseValid optionTypeString
	let invalid = parseInvalid optionTypeString
	
	$expect (valid "" "")
	$expect (valid "a" "a")
	$expect (valid "\12354" "\12354")
	$expect (valid "\56507" "\56507")
	$expect (valid "\61371" "\61371")

test_Text :: Suite
test_Text = assertions "text" $ do
	let p = Text.pack
	let valid = parseValid optionTypeText
	let invalid = parseInvalid optionTypeText
	
	$expect (valid "" (p ""))
	$expect (valid "a" (p "a"))
	$expect (valid "\12354" (p "\12354"))
	$expect (valid "\56507" (p "\65533"))
	$expect (valid "\61371" (p "\61371"))

test_FilePath :: Suite
test_FilePath = assertions "filepath" $ do
	let p = Path.decodeString Path.posix_ghc704
	let valid = parseValid optionTypeFilePath
	let invalid = parseInvalid optionTypeFilePath
	
	$expect (valid "" (p ""))
	$expect (valid "a" (p "a"))
	$expect (valid "a-\12403-c.txt" (p "a-\12403-c.txt"))
#if defined(CABAL_OS_WINDOWS)
	$expect (valid "a-\61371-c.txt" (p "a-\61371-c.txt"))
#elif __GLASGOW_HASKELL__ == 702
	$expect (valid "a-\61371-c.txt" (p "a-\56507-c.txt"))
#else
	$expect (valid "a-\56507-c.txt" (p "a-\56507-c.txt"))
	$expect (valid "a-\61371-c.txt" (p "a-\61371-c.txt"))
#endif

test_Int :: Suite
test_Int = assertions "int" $ do
	let valid = parseValid optionTypeInt
	let invalid = parseInvalid optionTypeInt
	
	$expect (valid "-1" (-1 :: Int))
	$expect (valid "1" (1 :: Int))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int) - 1)
	let pastMax = show (toInteger (maxBound :: Int) + 1)
	let errBounds = " is not within bounds [" ++ show (minBound :: Int) ++ ":" ++ show (maxBound :: Int) ++ "] of type int."
	
	$expect (invalid pastMin (pastMin ++ errBounds))
	$expect (valid (show (minBound :: Int)) minBound)
	$expect (valid (show (maxBound :: Int)) maxBound)
	$expect (invalid pastMax (pastMax ++ errBounds))

test_Int8 :: Suite
test_Int8 = assertions "int8" $ do
	let valid = parseValid optionTypeInt8
	let invalid = parseInvalid optionTypeInt8
	
	$expect (valid "-1" (-1 :: Int8))
	$expect (valid "1" (1 :: Int8))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int8) - 1)
	let pastMax = show (toInteger (maxBound :: Int8) + 1)
	$expect (invalid pastMin "-129 is not within bounds [-128:127] of type int8.")
	$expect (valid (show (minBound :: Int8)) minBound)
	$expect (valid (show (maxBound :: Int8)) maxBound)
	$expect (invalid pastMax "128 is not within bounds [-128:127] of type int8.")

test_Int16 :: Suite
test_Int16 = assertions "int16" $ do
	let valid = parseValid optionTypeInt16
	let invalid = parseInvalid optionTypeInt16
	
	$expect (valid "-1" (-1 :: Int16))
	$expect (valid "1" (1 :: Int16))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int16) - 1)
	let pastMax = show (toInteger (maxBound :: Int16) + 1)
	$expect (invalid pastMin "-32769 is not within bounds [-32768:32767] of type int16.")
	$expect (valid (show (minBound :: Int16)) minBound)
	$expect (valid (show (maxBound :: Int16)) maxBound)
	$expect (invalid pastMax "32768 is not within bounds [-32768:32767] of type int16.")

test_Int32 :: Suite
test_Int32 = assertions "int32" $ do
	let valid = parseValid optionTypeInt32
	let invalid = parseInvalid optionTypeInt32
	
	$expect (valid "-1" (-1 :: Int32))
	$expect (valid "1" (1 :: Int32))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int32) - 1)
	let pastMax = show (toInteger (maxBound :: Int32) + 1)
	$expect (invalid pastMin "-2147483649 is not within bounds [-2147483648:2147483647] of type int32.")
	$expect (valid (show (minBound :: Int32)) minBound)
	$expect (valid (show (maxBound :: Int32)) maxBound)
	$expect (invalid pastMax "2147483648 is not within bounds [-2147483648:2147483647] of type int32.")

test_Int64 :: Suite
test_Int64 = assertions "int64" $ do
	let valid = parseValid optionTypeInt64
	let invalid = parseInvalid optionTypeInt64
	
	$expect (valid "-1" (-1 :: Int64))
	$expect (valid "1" (1 :: Int64))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMin = show (toInteger (minBound :: Int64) - 1)
	let pastMax = show (toInteger (maxBound :: Int64) + 1)
	$expect (invalid pastMin "-9223372036854775809 is not within bounds [-9223372036854775808:9223372036854775807] of type int64.")
	$expect (valid (show (minBound :: Int64)) minBound)
	$expect (valid (show (maxBound :: Int64)) maxBound)
	$expect (invalid pastMax "9223372036854775808 is not within bounds [-9223372036854775808:9223372036854775807] of type int64.")

test_Word :: Suite
test_Word = assertions "word" $ do
	let valid = parseValid optionTypeWord
	let invalid = parseInvalid optionTypeWord
	
	let pastMax = show (toInteger (maxBound :: Word) + 1)
	let errBounds = " is not within bounds [0:" ++ show (maxBound :: Word) ++ "] of type word."
	
	$expect (invalid "-1" ("-1" ++ errBounds))
	$expect (valid "0" (0 :: Word))
	$expect (valid "1" (1 :: Word))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	$expect (valid (show (maxBound :: Word)) maxBound)
	$expect (invalid pastMax (pastMax ++ errBounds))

test_Word8 :: Suite
test_Word8 = assertions "word8" $ do
	let valid = parseValid optionTypeWord8
	let invalid = parseInvalid optionTypeWord8
	
	$expect (invalid "-1" "-1 is not within bounds [0:255] of type word8.")
	$expect (valid "0" (0 :: Word8))
	$expect (valid "1" (1 :: Word8))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word8) + 1)
	$expect (valid (show (maxBound :: Word8)) maxBound)
	$expect (invalid pastMax "256 is not within bounds [0:255] of type word8.")

test_Word16 :: Suite
test_Word16 = assertions "word16" $ do
	let valid = parseValid optionTypeWord16
	let invalid = parseInvalid optionTypeWord16
	
	$expect (invalid "-1" "-1 is not within bounds [0:65535] of type word16.")
	$expect (valid "0" (0 :: Word16))
	$expect (valid "1" (1 :: Word16))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word16) + 1)
	$expect (valid (show (maxBound :: Word16)) maxBound)
	$expect (invalid pastMax "65536 is not within bounds [0:65535] of type word16.")

test_Word32 :: Suite
test_Word32 = assertions "word32" $ do
	let valid = parseValid optionTypeWord32
	let invalid = parseInvalid optionTypeWord32
	
	$expect (invalid "-1" "-1 is not within bounds [0:4294967295] of type word32.")
	$expect (valid "0" (0 :: Word32))
	$expect (valid "1" (1 :: Word32))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word32) + 1)
	$expect (valid (show (maxBound :: Word32)) maxBound)
	$expect (invalid pastMax "4294967296 is not within bounds [0:4294967295] of type word32.")

test_Word64 :: Suite
test_Word64 = assertions "word64" $ do
	let valid = parseValid optionTypeWord64
	let invalid = parseInvalid optionTypeWord64
	
	$expect (invalid "-1" "-1 is not within bounds [0:18446744073709551615] of type word64.")
	$expect (valid "0" (0 :: Word64))
	$expect (valid "1" (1 :: Word64))
	$expect (invalid "a" "\"a\" is not an integer.")
	
	let pastMax = show (toInteger (maxBound :: Word64) + 1)
	$expect (valid (show (maxBound :: Word64)) maxBound)
	$expect (invalid pastMax "18446744073709551616 is not within bounds [0:18446744073709551615] of type word64.")

test_Integer :: Suite
test_Integer = assertions "integer" $ do
	let valid = parseValid optionTypeInteger
	let invalid = parseInvalid optionTypeInteger
	
	$expect (invalid "" "\"\" is not an integer.")
	$expect (valid "-1" (-1 :: Integer))
	$expect (valid "0" (0 :: Integer))
	$expect (valid "1" (1 :: Integer))
	$expect (invalid "a" "\"a\" is not an integer.")

test_Float :: Suite
test_Float = assertions "float" $ do
	let valid = parseValid optionTypeFloat
	let invalid = parseInvalid optionTypeFloat
	
	$expect (valid "-1" (-1 :: Float))
	$expect (valid "0" (0 :: Float))
	$expect (valid "1" (1 :: Float))
	$expect (valid "1.5" (1.5 :: Float))
	$expect (valid "3e5" (3e5 :: Float))
	$expect (invalid "a" "\"a\" is not a number.")

test_Double :: Suite
test_Double = assertions "double" $ do
	let valid = parseValid optionTypeDouble
	let invalid = parseInvalid optionTypeDouble
	
	$expect (valid "-1" (-1 :: Double))
	$expect (valid "0" (0 :: Double))
	$expect (valid "1" (1 :: Double))
	$expect (valid "1.5" (1.5 :: Double))
	$expect (valid "3e5" (3e5 :: Double))
	$expect (invalid "a" "\"a\" is not a number.")

test_Maybe :: Suite
test_Maybe = assertions "maybe" $ do
	let t = optionTypeMaybe optionTypeInt
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Nothing)
	$expect (valid "1" (Just 1))
	$expect (invalid "a" "\"a\" is not an integer.")

test_List :: Suite
test_List = assertions "list" $ do
	let t = optionTypeList ',' optionTypeInt
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" [])
	$expect (valid "1" [1])
	$expect (valid "1,2,3" [1, 2, 3])
	$expect (valid "1,1,2,3" [1, 1, 2, 3])
	$expect (invalid "1,a,3" "\"a\" is not an integer.")

test_Set :: Suite
test_Set = assertions "set" $ do
	let t = optionTypeSet ',' optionTypeInt
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Set.empty)
	$expect (valid "1" (Set.fromList [1]))
	$expect (valid "1,2,3" (Set.fromList [1, 2, 3]))
	$expect (valid "1,1,2,3" (Set.fromList [1, 2, 3]))
	$expect (invalid "1,a,3" "\"a\" is not an integer.")

test_Map :: Suite
test_Map = assertions "map" $ do
	let t = optionTypeMap ',' '=' optionTypeInt optionTypeInt
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "" Map.empty)
	$expect (valid "1=100" (Map.fromList [(1, 100)]))
	$expect (valid "1=100,2=200,3=300" (Map.fromList [(1, 100), (2, 200), (3, 300)]))
	$expect (valid "1=100,2=200,1=300" (Map.fromList [(1, 300), (2, 200)]))
	$expect (invalid "a=1" "\"a\" is not an integer.")
	$expect (invalid "1=a" "\"a\" is not an integer.")
	$expect (invalid "1=" "\"\" is not an integer.")
	$expect (invalid "1" "Map item \"1\" has no value.")

data TestEnum = Enum1 | Enum2 | Enum3
	deriving (Enum, Eq, Show)

test_Enum :: Suite
test_Enum = assertions "enum" $ do
	let t = optionTypeEnum ''TestEnum
		[ ("e1", Enum1)
		, ("e2", Enum2)
		, ("e3", Enum3)
		]
	let valid = parseValid t
	let invalid = parseInvalid t
	
	$expect (valid "e1" Enum1)
	$expect (valid "e2" Enum2)
	$expect (invalid "e4" "\"e4\" is not in {\"e1\", \"e2\", \"e3\"}.")