module Data.Repa.Convert.Format.String
        ( -- * Haskell Strings
          FixChars      (..)
        , VarChars      (..)
        , VarCharString (..)
        , ExactChars    (..)
        , unpackCharList)
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Repa.Convert.Internal.Packer
import Data.Repa.Convert.Format.Binary
import Data.Monoid
import Data.Word
import Data.Char
import GHC.Exts
import qualified Foreign.Storable               as S
import qualified Foreign.Ptr                    as S
import Prelude hiding (fail)
#include "repa-convert.h"


---------------------------------------------------------------------------------------------------
-- | Fixed length sequence of characters, represented as a (hated) Haskell `String`.
--   
-- * The runtime performance of the Haskell `String` is atrocious.
--   You really shouldn't be using them for large data sets.
--
-- * When packing, the length of the provided string must match the width
--   of the format, else packing will fail.
--
-- * When unpacking, the length of the result will be the width of the format.
--
data FixChars                   = FixChars Int          deriving (FixChars -> FixChars -> Bool
(FixChars -> FixChars -> Bool)
-> (FixChars -> FixChars -> Bool) -> Eq FixChars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixChars -> FixChars -> Bool
== :: FixChars -> FixChars -> Bool
$c/= :: FixChars -> FixChars -> Bool
/= :: FixChars -> FixChars -> Bool
Eq, Int -> FixChars -> ShowS
[FixChars] -> ShowS
FixChars -> String
(Int -> FixChars -> ShowS)
-> (FixChars -> String) -> ([FixChars] -> ShowS) -> Show FixChars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixChars -> ShowS
showsPrec :: Int -> FixChars -> ShowS
$cshow :: FixChars -> String
show :: FixChars -> String
$cshowList :: [FixChars] -> ShowS
showList :: [FixChars] -> ShowS
Show)
instance Format FixChars where
 type Value (FixChars)          = String
 fieldCount :: FixChars -> Int
fieldCount FixChars
_                   = Int
1
 minSize :: FixChars -> Int
minSize    (FixChars Int
len)      = Int
len
 fixedSize :: FixChars -> Maybe Int
fixedSize  (FixChars Int
len)      = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len
 packedSize :: FixChars -> Value FixChars -> Maybe Int
packedSize (FixChars Int
len) Value FixChars
_    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable FixChars where
 
  pack :: FixChars -> Value FixChars -> Packer
pack (FixChars Int
len) Value FixChars
xs 
   |  String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
Value FixChars
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
   =  (Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer
Packer ((Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer)
-> (Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer
forall a b. (a -> b) -> a -> b
$ \Addr#
dst IO ()
_fails Addr# -> IO ()
eat
   -> do ((Int, Char) -> IO ()) -> [(Int, Char)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
o, Char
x) -> Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
o (Int -> Word8
forall a. Integral a => a -> Word8
w8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
x)) 
                ([(Int, Char)] -> IO ()) -> [(Int, Char)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] String
Value FixChars
xs
         let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
         Addr# -> IO ()
eat Addr#
dst'

   | Bool
otherwise
   = (Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer
Packer ((Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer)
-> (Addr# -> IO () -> (Addr# -> IO ()) -> IO ()) -> Packer
forall a b. (a -> b) -> a -> b
$ \Addr#
_ IO ()
fails Addr# -> IO ()
_ -> IO ()
fails
  {-# NOINLINE pack #-}

  packer :: FixChars
-> Value FixChars -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer FixChars
f Value FixChars
v 
   = Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (FixChars -> Value FixChars -> Packer
forall format. Packable format => format -> Value format -> Packer
pack FixChars
f Value FixChars
v)
  {-# INLINE packer #-}


instance Unpackable FixChars where
  unpacker :: FixChars
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value FixChars -> IO ())
-> IO ()
unpacker (FixChars len :: Int
len@(I# Int#
len')) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value FixChars -> IO ()
eat
   = do 
        let lenBuf :: Int
lenBuf = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start)
        if  Int
lenBuf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
         then IO ()
fail
         else 
          do let load_unpackChar :: Int -> IO Char
load_unpackChar Int
o
                   = do Word8
x :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
o
                        Char -> IO Char
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IO Char) -> Char -> IO Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
                 {-# INLINE load_unpackChar #-}

             String
xs      <- (Int -> IO Char) -> [Int] -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO Char
load_unpackChar [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
             Addr# -> Value FixChars -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
len') String
Value FixChars
xs
  {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
-- | Like `FixChars`, but with a variable length.
data VarChars = VarChars        deriving (VarChars -> VarChars -> Bool
(VarChars -> VarChars -> Bool)
-> (VarChars -> VarChars -> Bool) -> Eq VarChars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarChars -> VarChars -> Bool
== :: VarChars -> VarChars -> Bool
$c/= :: VarChars -> VarChars -> Bool
/= :: VarChars -> VarChars -> Bool
Eq, Int -> VarChars -> ShowS
[VarChars] -> ShowS
VarChars -> String
(Int -> VarChars -> ShowS)
-> (VarChars -> String) -> ([VarChars] -> ShowS) -> Show VarChars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarChars -> ShowS
showsPrec :: Int -> VarChars -> ShowS
$cshow :: VarChars -> String
show :: VarChars -> String
$cshowList :: [VarChars] -> ShowS
showList :: [VarChars] -> ShowS
Show)
instance Format VarChars        where
 type Value VarChars            = String

 fieldCount :: VarChars -> Int
fieldCount VarChars
_                   = Int
1
 {-# INLINE fieldCount #-}

 minSize :: VarChars -> Int
minSize    VarChars
_                   = Int
0
 {-# INLINE minSize    #-}

 fixedSize :: VarChars -> Maybe Int
fixedSize  VarChars
VarChars            = Maybe Int
forall a. Maybe a
Nothing
 {-# INLINE fixedSize  #-}

 packedSize :: VarChars -> Value VarChars -> Maybe Int
packedSize VarChars
VarChars Value VarChars
xs         = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
Value VarChars
xs
 {-# NOINLINE packedSize #-}


instance Packable VarChars where

  pack :: VarChars -> Value VarChars -> Packer
pack VarChars
VarChars Value VarChars
xx
   = case Value VarChars
xx of
        []       -> Packer
forall a. Monoid a => a
mempty
        (Char
x : String
xs) -> Word8be -> Value Word8be -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Word8be
Word8be (Int -> Word8
forall a. Integral a => a -> Word8
w8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
x) Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> VarChars -> Value VarChars -> Packer
forall format. Packable format => format -> Value format -> Packer
pack VarChars
VarChars String
Value VarChars
xs     
  {-# NOINLINE pack #-}

  packer :: VarChars
-> Value VarChars -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer VarChars
f Value VarChars
v 
   = Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (VarChars -> Value VarChars -> Packer
forall format. Packable format => format -> Value format -> Packer
pack VarChars
f Value VarChars
v)
  {-# INLINE packer #-}


instance Unpackable VarChars where
  unpacker :: VarChars
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarChars -> IO ())
-> IO ()
unpacker VarChars
VarChars Addr#
start Addr#
end Word8 -> Bool
stop IO ()
_fail Addr# -> Value VarChars -> IO ()
eat
   = do (Ptr Addr#
ptr, String
str)      <- Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO (Ptr Word8, String)
unpackCharList (Addr# -> Ptr Word8
pw8 Addr#
start) (Addr# -> Ptr Word8
pw8 Addr#
end) Word8 -> Bool
stop
        Addr# -> Value VarChars -> IO ()
eat Addr#
ptr String
Value VarChars
str
  {-# INLINE unpacker #-}


-- | Unpack a ascii text from the given buffer.
unpackCharList
        :: S.Ptr Word8      -- ^ First byte in buffer.
        -> S.Ptr Word8      -- ^ First byte after buffer.
        -> (Word8 -> Bool)  -- ^ Detect field deliminator.
        -> IO (S.Ptr Word8, [Char])

unpackCharList :: Ptr Word8 -> Ptr Word8 -> (Word8 -> Bool) -> IO (Ptr Word8, String)
unpackCharList Ptr Word8
start Ptr Word8
end Word8 -> Bool
stop
 = Ptr Word8 -> String -> IO (Ptr Word8, String)
go Ptr Word8
start []
 where  go :: Ptr Word8 -> String -> IO (Ptr Word8, String)
go !Ptr Word8
ptr !String
acc
         | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end
         = (Ptr Word8, String) -> IO (Ptr Word8, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
ptr, ShowS
forall a. [a] -> [a]
reverse String
acc)

         | Bool
otherwise
         = do   Word8
w :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word8
ptr
                if Word8 -> Bool
stop Word8
w 
                 then do
                   (Ptr Word8, String) -> IO (Ptr Word8, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
ptr, ShowS
forall a. [a] -> [a]
reverse String
acc)
                 else do
                   let !ptr' :: Ptr Word8
ptr'  = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr Ptr Word8
ptr Int
1
                   Ptr Word8 -> String -> IO (Ptr Word8, String)
go Ptr Word8
ptr' ((Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
{-# NOINLINE unpackCharList #-}


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

 minSize :: VarCharString -> Int
minSize    VarCharString
_                   = Int
2
 {-# INLINE minSize #-}

 fixedSize :: VarCharString -> Maybe Int
fixedSize  VarCharString
_                   = Maybe Int
forall a. Maybe a
Nothing
 {-# INLINE fixedSize #-}
 
 packedSize :: VarCharString -> Value VarCharString -> Maybe Int
packedSize VarCharString
VarCharString Value VarCharString
xs        
  = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
Value VarCharString
xs     
 {-# NOINLINE packedSize #-}


instance Packable VarCharString where

 -- ISSUE #43: Avoid intermediate lists when packing Ints and Strings.
 packer :: VarCharString
-> Value VarCharString
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer     VarCharString
VarCharString Value VarCharString
xx          Addr#
start IO ()
k
  =  VarChars
-> Value VarChars -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer VarChars
VarChars (ShowS
forall a. Show a => a -> String
show String
Value VarCharString
xx) Addr#
start IO ()
k
 {-# INLINE packer #-}


instance Unpackable VarCharString where
 unpacker :: VarCharString
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarCharString -> IO ())
-> IO ()
unpacker   VarCharString
VarCharString Addr#
start Addr#
end Word8 -> Bool
_stop  IO ()
fail Addr# -> Value VarCharString -> IO ()
eat
  = Ptr Word8
-> Ptr Word8 -> IO () -> (Addr# -> String -> IO ()) -> IO ()
unpackString (Addr# -> Ptr Word8
pw8 Addr#
start) (Addr# -> Ptr Word8
pw8 Addr#
end) IO ()
fail Addr# -> String -> IO ()
Addr# -> Value VarCharString -> IO ()
eat
 {-# INLINE unpacker #-}


-- | Unpack a string from the given buffer.
---
--   We only handle the most common special character encodings.
--   Is there a standard for which ones these are?
--
unpackString 
        :: S.Ptr Word8                  -- ^ First byte in buffer.
        -> S.Ptr Word8                  -- ^ First byte after buffer.
        -> IO ()                        -- ^ Signal failure.
        -> (Addr# -> [Char] -> IO ())   -- ^ Eat an unpacked value.
        -> IO ()

unpackString :: Ptr Word8
-> Ptr Word8 -> IO () -> (Addr# -> String -> IO ()) -> IO ()
unpackString Ptr Word8
start Ptr Word8
end IO ()
fail Addr# -> String -> IO ()
eat
 = Ptr Word8 -> IO ()
open Ptr Word8
start
 where
        -- Accept the open quotes.
        open :: Ptr Word8 -> IO ()
open !Ptr Word8
ptr
         | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end
         = IO ()
fail

         | Bool
otherwise
         = do   Word8
w :: Word8  <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word8
ptr
                let !ptr' :: Ptr Word8
ptr'   =  Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr Ptr Word8
ptr Int
1 
                case Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w of
                 Char
'"'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' []
                 Char
_      -> IO ()
fail

        -- Handle the next character in the string.
        go_body :: Ptr Word8 -> String -> IO ()
go_body !ptr :: Ptr Word8
ptr@(Ptr Addr#
addr) !String
acc
         | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end 
         = Addr# -> String -> IO ()
eat Addr#
addr (ShowS
forall a. [a] -> [a]
reverse String
acc)

         | Bool
otherwise
         = do   Word8
w :: Word8  <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word8
ptr
                let !ptr' :: Ptr Word8
ptr'@(Ptr Addr#
addr')   =  Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr Ptr Word8
ptr Int
1
                case Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w of
                 Char
'"'    -> Addr# -> String -> IO ()
eat Addr#
addr' (ShowS
forall a. [a] -> [a]
reverse String
acc)
                 Char
'\\'   -> Ptr Word8 -> String -> IO ()
go_escape Ptr Word8
ptr' String
acc
                 Char
c      -> Ptr Word8 -> String -> IO ()
go_body   Ptr Word8
ptr' (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)

        -- Handle escaped character.
        -- The previous character was a '\\'
        go_escape :: Ptr Word8 -> String -> IO ()
go_escape !Ptr Word8
ptr !String
acc
         | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end
         = IO ()
fail

         | Bool
otherwise
         = do   Word8
w :: Word8  <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word8
ptr
                let ptr' :: Ptr Word8
ptr'    =  Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr Ptr Word8
ptr Int
1
                case Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w of
                 Char
'a'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\a' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'b'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\b' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'f'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\f' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'n'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'r'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\r' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
't'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\t' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'v'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\v' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'\\'   -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
'"'    -> Ptr Word8 -> String -> IO ()
go_body Ptr Word8
ptr' (Char
'"'  Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
                 Char
_      -> IO ()
fail
{-# NOINLINE unpackString #-}


---------------------------------------------------------------------------------------------------
-- | Match an exact sequence of characters.
data ExactChars
        = ExactChars String
        deriving Int -> ExactChars -> ShowS
[ExactChars] -> ShowS
ExactChars -> String
(Int -> ExactChars -> ShowS)
-> (ExactChars -> String)
-> ([ExactChars] -> ShowS)
-> Show ExactChars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExactChars -> ShowS
showsPrec :: Int -> ExactChars -> ShowS
$cshow :: ExactChars -> String
show :: ExactChars -> String
$cshowList :: [ExactChars] -> ShowS
showList :: [ExactChars] -> ShowS
Show


instance Format ExactChars where
 type Value ExactChars          = ()
 fieldCount :: ExactChars -> Int
fieldCount (ExactChars String
_)      = Int
0
 {-# INLINE   fieldCount #-}

 minSize :: ExactChars -> Int
minSize    (ExactChars String
str)    = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
 {-# NOINLINE minSize  #-}

 fixedSize :: ExactChars -> Maybe Int
fixedSize  (ExactChars String
str)    = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str)
 {-# NOINLINE fixedSize #-}

 packedSize :: ExactChars -> Value ExactChars -> Maybe Int
packedSize (ExactChars String
str) () = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str)
 {-# NOINLINE packedSize #-}


instance Packable ExactChars where
 packer :: ExactChars
-> Value ExactChars -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer (ExactChars String
str) Value ExactChars
_ Addr#
dst IO ()
_fails Addr# -> IO ()
k
  = do  let !len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
        ((Int, Char) -> IO ()) -> [(Int, Char)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
o, Char
x) -> Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
o (Int -> Word8
forall a. Integral a => a -> Word8
w8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
x))
                ([(Int, Char)] -> IO ()) -> [(Int, Char)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] String
str
        let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
        Addr# -> IO ()
k Addr#
dst'
 {-# NOINLINE packer #-}


instance Unpackable ExactChars where
 unpacker :: ExactChars
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value ExactChars -> IO ())
-> IO ()
unpacker (ExactChars String
str) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fails Addr# -> Value ExactChars -> IO ()
eat
  = do  let !len :: Int
len@(I# Int#
len') = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
        let !lenBuf :: Int
lenBuf        = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start)
        if  Int
lenBuf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
         then IO ()
fails
         else do
                let load_unpackChar :: Int -> IO Char
load_unpackChar Int
o
                      = do Word8
x :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
o
                           Char -> IO Char
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IO Char) -> Char -> IO Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
                    {-# INLINE load_unpackChar #-}

                String
xs      <- (Int -> IO Char) -> [Int] -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO Char
load_unpackChar [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                if (String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str)
                 then Addr# -> Value ExactChars -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
len') ()
                 else IO ()
fails
 {-# NOINLINE unpacker #-}


---------------------------------------------------------------------------------------------------
w8  :: Integral a => a -> Word8
w8 :: forall a. Integral a => a -> Word8
w8 = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w8  #-}


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