{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
	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 instances for 'System.IO.TextEncoding'.
-}

module BishBosh.Text.Encoding (
-- * Constants
	tag
--	range
 ) where

import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	Data.Default
import qualified	Data.List.Extra
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT
import qualified	Text.XML.HXT.Arrow.Pickle.Schema
import qualified	System.IO

-- | Used to label an XML-attribute.
tag :: String
tag :: String
tag	= String
"textEncoding"

instance Eq System.IO.TextEncoding where
	TextEncoding
l == :: TextEncoding -> TextEncoding -> Bool
== TextEncoding
r	= TextEncoding -> String
forall a. Show a => a -> String
show TextEncoding
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TextEncoding -> String
forall a. Show a => a -> String
show TextEncoding
r

instance Read System.IO.TextEncoding where
	readsPrec :: Int -> ReadS TextEncoding
readsPrec Int
_ String
s	= case String -> String
Data.List.Extra.trimStart String
s of
		Char
'I':Char
'S':Char
'O':String
remainder -> case String
remainder of
			Char
'8':Char
'8':Char
'5':Char
'9':Char
'-':Char
'1':String
remainder2	-> (TextEncoding, String) -> [(TextEncoding, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-} ((TextEncoding, String) -> [(TextEncoding, String)])
-> (String -> (TextEncoding, String)) -> ReadS TextEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) TextEncoding
System.IO.latin1 ReadS TextEncoding -> ReadS TextEncoding
forall a b. (a -> b) -> a -> b
$ case String
remainder2 of
				Char
'(':Char
'c':Char
'h':Char
'e':Char
'c':Char
'k':Char
'e':Char
'd':Char
')':String
remainder3	-> String
remainder3
				String
_						-> String
remainder2
			Char
'-':Char
'8':Char
'8':Char
'5':Char
'9':Char
'-':Char
'1':String
remainder2	-> (TextEncoding, String) -> [(TextEncoding, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-} ((TextEncoding, String) -> [(TextEncoding, String)])
-> (String -> (TextEncoding, String)) -> ReadS TextEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) TextEncoding
System.IO.latin1 ReadS TextEncoding -> ReadS TextEncoding
forall a b. (a -> b) -> a -> b
$ case String
remainder2 of
				Char
'(':Char
'c':Char
'h':Char
'e':Char
'c':Char
'k':Char
'e':Char
'd':Char
')':String
remainder3	-> String
remainder3
				String
_						-> String
remainder2
			String
_					-> []	-- No parse.
		Char
'U':Char
'T':Char
'F':Char
'-':String
remainder -> case String
remainder of
			Char
'8':String
remainder2		-> [(TextEncoding
System.IO.utf8, String
remainder2)]
			Char
'1':Char
'6':String
remainder2	-> [(TextEncoding
System.IO.utf16, String
remainder2)]
			Char
'3':Char
'2':String
remainder2	-> [(TextEncoding
System.IO.utf32, String
remainder2)]
			String
_			-> []	-- No parse.
		String
_	-> []	-- No parse.

instance HXT.XmlPickler System.IO.TextEncoding where
	xpickle :: PU TextEncoding
xpickle	= TextEncoding -> PU TextEncoding -> PU TextEncoding
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault TextEncoding
forall a. Default a => a
Data.Default.def (PU TextEncoding -> PU TextEncoding)
-> ([String] -> PU TextEncoding) -> [String] -> PU TextEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> TextEncoding, TextEncoding -> String)
-> PU String -> PU TextEncoding
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> TextEncoding
forall a. Read a => String -> a
read, TextEncoding -> String
forall a. Show a => a -> String
show) (PU String -> PU TextEncoding)
-> ([String] -> PU String) -> [String] -> PU TextEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU TextEncoding) -> [String] -> PU TextEncoding
forall a b. (a -> b) -> a -> b
$ (TextEncoding -> String) -> [TextEncoding] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TextEncoding -> String
forall a. Show a => a -> String
show [TextEncoding]
range

instance Data.Default.Default System.IO.TextEncoding where
	def :: TextEncoding
def	= TextEncoding
System.IO.utf8

-- | The constant range of /Text-encoding/s.
range :: [System.IO.TextEncoding]
range :: [TextEncoding]
range	= [
	TextEncoding
System.IO.latin1,
	TextEncoding
System.IO.utf8,
	TextEncoding
System.IO.utf16,
	TextEncoding
System.IO.utf32
 ]

instance Property.FixedMembership.FixedMembership System.IO.TextEncoding where
	members :: [TextEncoding]
members	= [TextEncoding]
range