{-# LANGUAGE CPP #-}

-- | Flat instances for the text library
module Flat.Instances.Text(
  UTF8Text(..)
#if! defined (ETA_VERSION) && ! defined (ETA)
  ,UTF16Text(..)
#endif
) where

import qualified Data.Text           as T
import qualified Data.Text.Lazy      as TL
import           Flat.Instances.Util

-- $setup
-- >>> import Flat.Instances.Base()
-- >>> import Flat.Instances.Test
-- >>> import qualified Data.Text             as T
-- >>> import qualified Data.Text.Lazy             as TL
-- >>> import Data.Word
-- >>> tt t = let (ts,_,bs) = tst t in (ts,bs) 

{- |
Text (and Data.Text.Lazy) is encoded as a byte aligned array of bytes corresponding to its UTF8 encoding.

>>> tt $ T.pack ""
(True,[1,0])

>>> tt $ T.pack "aaa"
(True,[1,3,97,97,97,0])

>>> tt $ T.pack "¢¢¢"
(True,[1,6,194,162,194,162,194,162,0])

>>> tt $ T.pack "日日日"
(True,[1,9,230,151,165,230,151,165,230,151,165,0])

#ifndef ETA
>>> tt $ T.pack "𐍈𐍈𐍈"
(True,[1,12,240,144,141,136,240,144,141,136,240,144,141,136,0])
#endif

Strict and Lazy Text have the same encoding:

>>> tst (T.pack "abc") == tst (TL.pack "abc")
True
-}
instance Flat T.Text where
  size :: Text -> NumBits -> NumBits
size = Text -> NumBits -> NumBits
sUTF8Max
  encode :: Text -> Encoding
encode = Text -> Encoding
eUTF8
  decode :: Get Text
decode = Get Text
dUTF8

instance Flat TL.Text where
  size :: Text -> NumBits -> NumBits
size = Text -> NumBits -> NumBits
sUTF8Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
  encode :: Text -> Encoding
encode = Text -> Encoding
eUTF8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
  decode :: Get Text
decode = Text -> Text
TL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
dUTF8

{-|
The desired text encoding can be explicitly specified using the wrappers UTF8Text and UTF16Text.

The default encoding is UTF8:

>>> tst (UTF8Text $ T.pack "日日日") == tst (T.pack "日日日")
True
-}
-- |A wrapper to encode/decode Text as UTF8
newtype UTF8Text = UTF8Text {UTF8Text -> Text
unUTF8::T.Text} deriving (UTF8Text -> UTF8Text -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTF8Text -> UTF8Text -> Bool
$c/= :: UTF8Text -> UTF8Text -> Bool
== :: UTF8Text -> UTF8Text -> Bool
$c== :: UTF8Text -> UTF8Text -> Bool
Eq,Eq UTF8Text
UTF8Text -> UTF8Text -> Bool
UTF8Text -> UTF8Text -> Ordering
UTF8Text -> UTF8Text -> UTF8Text
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UTF8Text -> UTF8Text -> UTF8Text
$cmin :: UTF8Text -> UTF8Text -> UTF8Text
max :: UTF8Text -> UTF8Text -> UTF8Text
$cmax :: UTF8Text -> UTF8Text -> UTF8Text
>= :: UTF8Text -> UTF8Text -> Bool
$c>= :: UTF8Text -> UTF8Text -> Bool
> :: UTF8Text -> UTF8Text -> Bool
$c> :: UTF8Text -> UTF8Text -> Bool
<= :: UTF8Text -> UTF8Text -> Bool
$c<= :: UTF8Text -> UTF8Text -> Bool
< :: UTF8Text -> UTF8Text -> Bool
$c< :: UTF8Text -> UTF8Text -> Bool
compare :: UTF8Text -> UTF8Text -> Ordering
$ccompare :: UTF8Text -> UTF8Text -> Ordering
Ord,NumBits -> UTF8Text -> ShowS
[UTF8Text] -> ShowS
UTF8Text -> String
forall a.
(NumBits -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTF8Text] -> ShowS
$cshowList :: [UTF8Text] -> ShowS
show :: UTF8Text -> String
$cshow :: UTF8Text -> String
showsPrec :: NumBits -> UTF8Text -> ShowS
$cshowsPrec :: NumBits -> UTF8Text -> ShowS
Show)

instance Flat UTF8Text where
  size :: UTF8Text -> NumBits -> NumBits
size (UTF8Text Text
t) = Text -> NumBits -> NumBits
sUTF8Max Text
t
  encode :: UTF8Text -> Encoding
encode (UTF8Text Text
t) = Text -> Encoding
eUTF8 Text
t
  decode :: Get UTF8Text
decode = Text -> UTF8Text
UTF8Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
dUTF8

#if ! defined (ETA_VERSION) && ! defined (ETA)
{-|
>>> tt (UTF16Text $ T.pack "aaa")
(True,[1,6,97,0,97,0,97,0,0])

>>> tt (UTF16Text $ T.pack "𐍈𐍈𐍈")
(True,[1,12,0,216,72,223,0,216,72,223,0,216,72,223,0])
-}

-- |A wrapper to encode/decode Text as UTF16
newtype UTF16Text = UTF16Text {UTF16Text -> Text
unUTF16::T.Text} deriving (UTF16Text -> UTF16Text -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTF16Text -> UTF16Text -> Bool
$c/= :: UTF16Text -> UTF16Text -> Bool
== :: UTF16Text -> UTF16Text -> Bool
$c== :: UTF16Text -> UTF16Text -> Bool
Eq,Eq UTF16Text
UTF16Text -> UTF16Text -> Bool
UTF16Text -> UTF16Text -> Ordering
UTF16Text -> UTF16Text -> UTF16Text
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UTF16Text -> UTF16Text -> UTF16Text
$cmin :: UTF16Text -> UTF16Text -> UTF16Text
max :: UTF16Text -> UTF16Text -> UTF16Text
$cmax :: UTF16Text -> UTF16Text -> UTF16Text
>= :: UTF16Text -> UTF16Text -> Bool
$c>= :: UTF16Text -> UTF16Text -> Bool
> :: UTF16Text -> UTF16Text -> Bool
$c> :: UTF16Text -> UTF16Text -> Bool
<= :: UTF16Text -> UTF16Text -> Bool
$c<= :: UTF16Text -> UTF16Text -> Bool
< :: UTF16Text -> UTF16Text -> Bool
$c< :: UTF16Text -> UTF16Text -> Bool
compare :: UTF16Text -> UTF16Text -> Ordering
$ccompare :: UTF16Text -> UTF16Text -> Ordering
Ord,NumBits -> UTF16Text -> ShowS
[UTF16Text] -> ShowS
UTF16Text -> String
forall a.
(NumBits -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTF16Text] -> ShowS
$cshowList :: [UTF16Text] -> ShowS
show :: UTF16Text -> String
$cshow :: UTF16Text -> String
showsPrec :: NumBits -> UTF16Text -> ShowS
$cshowsPrec :: NumBits -> UTF16Text -> ShowS
Show)

instance Flat UTF16Text where
  size :: UTF16Text -> NumBits -> NumBits
size (UTF16Text Text
t) = Text -> NumBits -> NumBits
sUTF16 Text
t
  encode :: UTF16Text -> Encoding
encode (UTF16Text Text
t) = Text -> Encoding
eUTF16 Text
t
  decode :: Get UTF16Text
decode = Text -> UTF16Text
UTF16Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
dUTF16
#endif