module Data.Repa.Convert.Format.String
(
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"
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 #-}
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 #-}
unpackCharList
:: S.Ptr Word8
-> S.Ptr Word8
-> (Word8 -> Bool)
-> 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 #-}
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
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 #-}
unpackString
:: S.Ptr Word8
-> S.Ptr Word8
-> IO ()
-> (Addr# -> [Char] -> IO ())
-> 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
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
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)
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 #-}
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 #-}