-- | Conversions for "Data.Text" things.
module Data.Repa.Convert.Format.Text
        ( VarText       (..)
        , VarTextString (..))
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Repa.Convert.Format.String
import Data.Text                                (Text)
import Data.Word
import GHC.Exts
import qualified Data.Text.Foreign              as T
import qualified Data.Text                      as T
import qualified Foreign.Storable               as F
import qualified Foreign.Ptr                    as F


---------------------------------------------------------------------------------------------------
-- | Variable length unicode text, represented as a "Data.Text" thing.
--
data VarText                    = VarText       deriving (VarText -> VarText -> Bool
(VarText -> VarText -> Bool)
-> (VarText -> VarText -> Bool) -> Eq VarText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarText -> VarText -> Bool
== :: VarText -> VarText -> Bool
$c/= :: VarText -> VarText -> Bool
/= :: VarText -> VarText -> Bool
Eq, Int -> VarText -> ShowS
[VarText] -> ShowS
VarText -> String
(Int -> VarText -> ShowS)
-> (VarText -> String) -> ([VarText] -> ShowS) -> Show VarText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarText -> ShowS
showsPrec :: Int -> VarText -> ShowS
$cshow :: VarText -> String
show :: VarText -> String
$cshowList :: [VarText] -> ShowS
showList :: [VarText] -> ShowS
Show)
instance Format VarText         where
 type Value VarText             = Text
 fieldCount :: VarText -> Int
fieldCount VarText
_                   = Int
1
 minSize :: VarText -> Int
minSize    VarText
_                   = Int
0
 fixedSize :: VarText -> Maybe Int
fixedSize  VarText
VarText             = Maybe Int
forall a. Maybe a
Nothing
 packedSize :: VarText -> Value VarText -> Maybe Int
packedSize VarText
VarText Value VarText
xs          = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
Value VarText
xs
 {-# INLINE fieldCount #-}
 {-# INLINE minSize #-}
 {-# INLINE fixedSize #-}
 {-# INLINE packedSize #-}


instance Packable VarText where

 packer :: VarText
-> Value VarText -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer   VarText
VarText Value VarText
tt Addr#
dst IO ()
_fails Addr# -> IO ()
eat
  = Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
T.withCStringLen Text
Value VarText
tt
  ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len)
  -> let        
        packer_VarText :: Int -> IO ()
packer_VarText !Int
ix
         | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
         = let  !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
ix
           in   Addr# -> IO ()
eat Addr#
dst'

         | Bool
otherwise
         = do   !(Word8
x :: Word8)   <- Ptr CChar -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff Ptr CChar
ptr Int
ix
                Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
F.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
ix Word8
x
                Int -> IO ()
packer_VarText (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        {-# INLINE packer_VarText #-}

     in Int -> IO ()
packer_VarText Int
0
 {-# INLINE packer #-}


instance Unpackable VarText where
 unpacker :: VarText
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarText -> IO ())
-> IO ()
unpacker VarText
VarText Addr#
start Addr#
end Word8 -> Bool
stop IO ()
_fail Addr# -> Value VarText -> IO ()
eat
  = Int -> IO ()
scanLen Int
0
  where
        -- Length of the input buffer.
        !lenBuf :: Int
lenBuf = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
F.minusPtr (Addr# -> Ptr Word8
pw8 Addr#
end) (Addr# -> Ptr Word8
pw8 Addr#
start)

        -- Scan through the input to see how long the field is.
        scanLen :: Int -> IO ()
scanLen !Int
ix
         | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenBuf
         = Int -> IO ()
copyField Int
lenBuf

         | Bool
otherwise
         = do   Word8
x       <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
ix
                if Word8 -> Bool
stop Word8
x
                 then Int -> IO ()
copyField Int
ix
                 else Int -> IO ()
scanLen (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        {-# INLINE scanLen #-}

        -- Decode the UTF-8 bytes into a new buffer.
        copyField :: Int -> IO ()
copyField !Int
lenField
         = do   Text
tt      <- CStringLen -> IO Text
T.peekCStringLen (Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
start, Int
lenField)
                let !(Ptr Addr#
start') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
start) Int
lenField
                Addr# -> Value VarText -> IO ()
eat Addr#
start' Text
Value VarText
tt
        {-# INLINE copyField #-}
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
-- | Variable length string in double quotes,
--   and standard backslash encoding of non-printable characters.
data VarTextString              = VarTextString deriving (VarTextString -> VarTextString -> Bool
(VarTextString -> VarTextString -> Bool)
-> (VarTextString -> VarTextString -> Bool) -> Eq VarTextString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarTextString -> VarTextString -> Bool
== :: VarTextString -> VarTextString -> Bool
$c/= :: VarTextString -> VarTextString -> Bool
/= :: VarTextString -> VarTextString -> Bool
Eq, Int -> VarTextString -> ShowS
[VarTextString] -> ShowS
VarTextString -> String
(Int -> VarTextString -> ShowS)
-> (VarTextString -> String)
-> ([VarTextString] -> ShowS)
-> Show VarTextString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarTextString -> ShowS
showsPrec :: Int -> VarTextString -> ShowS
$cshow :: VarTextString -> String
show :: VarTextString -> String
$cshowList :: [VarTextString] -> ShowS
showList :: [VarTextString] -> ShowS
Show)
instance Format VarTextString   where
 type Value VarTextString       = Text
 fieldCount :: VarTextString -> Int
fieldCount VarTextString
_                   = Int
1
 minSize :: VarTextString -> Int
minSize    VarTextString
_                   = Int
2
 fixedSize :: VarTextString -> Maybe Int
fixedSize  VarTextString
VarTextString       = Maybe Int
forall a. Maybe a
Nothing
 packedSize :: VarTextString -> Value VarTextString -> Maybe Int
packedSize VarTextString
VarTextString Value VarTextString
xs    = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
Value VarTextString
xs
 {-# INLINE fieldCount #-}
 {-# INLINE minSize #-}
 {-# INLINE fixedSize #-}
 {-# INLINE packedSize #-}


instance Packable VarTextString where
 
 -- We go via lists here to get 'show's' expansion of special characters.
 packer :: VarTextString
-> Value VarTextString
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer VarTextString
VarTextString Value VarTextString
tt Addr#
buf IO ()
k
  = VarText
-> Value VarText -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer VarText
VarText (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
Value VarTextString
tt) Addr#
buf IO ()
k
 {-# INLINE packer #-}


instance Unpackable VarTextString where

 unpacker :: VarTextString
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarTextString -> IO ())
-> IO ()
unpacker VarTextString
VarTextString Addr#
start Addr#
end Word8 -> Bool
stop IO ()
_fail Addr# -> Value VarTextString -> IO ()
eat
  = VarCharString
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarCharString -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker VarCharString
VarCharString Addr#
start Addr#
end Word8 -> Bool
stop IO ()
_fail 
  ((Addr# -> Value VarCharString -> IO ()) -> IO ())
-> (Addr# -> Value VarCharString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start' Value VarCharString
val -> Addr# -> Value VarTextString -> IO ()
eat Addr#
start' (String -> Text
T.pack String
Value VarCharString
val)
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
pw8 :: Addr# -> Ptr Word8
pw8 :: Addr# -> Ptr Word8
pw8 Addr#
addr = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr
{-# INLINE pw8 #-}