{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 
-- "r-UNICODE.D76" restricts Unicode characters by excluding the range U+D800 to U+DFFF.
--
-- This is important because the commonly used @Text@ type from /text/ package replaces chars that are in range
-- U+D800 to U+DFFF (inclusive).
--
-- Note, there is no @IsSuperset "r-UNICODE.D76" "r-CHAR8"@ mapping even though the numeric range of D76 includes all CHAR8 bytes.
-- This is more /nominal/ decision that prevents certain unwanted conversions from being possible.
--
-- Similarly there is no IsSuperset "r-UNICODE.D76" "r-ByteRep", "r-UNICODE.D76" acts as a guard to what can go into @Text@
-- and this prevents some unwanted conversions.
-- 
-- @since 0.4.0.0
module Data.TypedEncoding.Instances.Restriction.D76 where

import           Data.TypedEncoding.Instances.Support
import           Data.TypedEncoding.Common.Class.Util.StringConstraints

import           Data.TypedEncoding.Internal.Util (explainBool)
import           Data.Char


-- $setup
-- >>> :set -XDataKinds -XTypeApplications


-----------------
-- Encodings  --
-----------------

newtype NonTextChar = NonTextChar Char deriving (NonTextChar -> NonTextChar -> Bool
(NonTextChar -> NonTextChar -> Bool)
-> (NonTextChar -> NonTextChar -> Bool) -> Eq NonTextChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonTextChar -> NonTextChar -> Bool
$c/= :: NonTextChar -> NonTextChar -> Bool
== :: NonTextChar -> NonTextChar -> Bool
$c== :: NonTextChar -> NonTextChar -> Bool
Eq, Int -> NonTextChar -> ShowS
[NonTextChar] -> ShowS
NonTextChar -> String
(Int -> NonTextChar -> ShowS)
-> (NonTextChar -> String)
-> ([NonTextChar] -> ShowS)
-> Show NonTextChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonTextChar] -> ShowS
$cshowList :: [NonTextChar] -> ShowS
show :: NonTextChar -> String
$cshow :: NonTextChar -> String
showsPrec :: Int -> NonTextChar -> ShowS
$cshowsPrec :: Int -> NonTextChar -> ShowS
Show)

-- * Encoding @"r-UNICODE.D76"@

instance Encode (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char where
    encoding :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char
encoding = Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char
forall c.
Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char
encD76Char    

instance Encode (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String where
    encoding :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
encoding = Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
forall c.
Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
encD76

encD76Char :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char 
encD76Char :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c Char
encD76Char = (Char -> Either NonTextChar Char)
-> Encoding
     (Either EncodeEx) "r-UNICODE.D76" (AlgNm "r-UNICODE.D76") c Char
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx (\Char
c -> (Char -> NonTextChar) -> (Char, Bool) -> Either NonTextChar Char
forall a err. (a -> err) -> (a, Bool) -> Either err a
explainBool Char -> NonTextChar
NonTextChar (Char
c, Char -> Bool
nonTextChar Char
c))    

encD76 :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
encD76 :: Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
encD76 = (String -> Either NonTextChar String)
-> Encoding
     (Either EncodeEx) "r-UNICODE.D76" (AlgNm "r-UNICODE.D76") c String
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx @"r-UNICODE.D76" String -> Either NonTextChar String
encImpl

-- | No-check version
trustMe :: Applicative f =>  Encoding f "r-UNICODE.D76" "r-UNICODE.D76" c String
trustMe :: Encoding f "r-UNICODE.D76" "r-UNICODE.D76" c String
trustMe = ShowS
-> Encoding f "r-UNICODE.D76" (AlgNm "r-UNICODE.D76") c String
forall (nm :: Symbol) (f :: * -> *) c str.
Applicative f =>
(str -> str) -> Encoding f nm (AlgNm nm) c str
_implEncodingP ShowS
forall a. a -> a
id



-- * Decoding @"r-UNICODE.D76"@

instance (Applicative f) => Decode f "r-UNICODE.D76" "r-UNICODE.D76" c str where
    decoding :: Decoding f "r-UNICODE.D76" "r-UNICODE.D76" c str
decoding = Decoding f "r-UNICODE.D76" "r-UNICODE.D76" c str
forall (r :: Symbol) (f :: * -> *) c str.
(Restriction r, Applicative f) =>
Decoding f r r c str
decAnyR
    
instance (RecreateErr f, Applicative f) => Validate f "r-UNICODE.D76" "r-UNICODE.D76" () String where
    validation :: Validation f "r-UNICODE.D76" "r-UNICODE.D76" () String
validation = Encoding
  (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" () String
-> Validation f "r-UNICODE.D76" "r-UNICODE.D76" () String
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding
  (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" () String
forall c.
Encoding (Either EncodeEx) "r-UNICODE.D76" "r-UNICODE.D76" c String
encD76


-- * Implementation 

-- @'\xd800'@ to  @'\xdfff'@ inclusive
nonTextChar :: Char -> Bool
nonTextChar :: Char -> Bool
nonTextChar Char
c =  Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
55296 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
57343
   where x :: Int
x = Char -> Int
ord Char
c


-- \ UNICODE.D76
encImpl :: String -> Either NonTextChar String
encImpl :: String -> Either NonTextChar String
encImpl String
str = case (Char -> Bool) -> String -> Maybe Char
forall str. Char8Find str => (Char -> Bool) -> str -> Maybe Char
find Char -> Bool
nonTextChar String
str of 
    Maybe Char
Nothing -> String -> Either NonTextChar String
forall a b. b -> Either a b
Right String
str
    Just Char
ch -> NonTextChar -> Either NonTextChar String
forall a b. a -> Either a b
Left (NonTextChar -> Either NonTextChar String)
-> NonTextChar -> Either NonTextChar String
forall a b. (a -> b) -> a -> b
$ Char -> NonTextChar
NonTextChar Char
ch