module Data.Repa.Convert.Format.Maybe
( MaybeChars (..)
, MaybeBytes (..))
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Repa.Convert.Format.Bytes
import Data.Word
import GHC.Exts
import Prelude hiding (fail)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Internal as BS
import qualified Foreign.Storable as F
import qualified Foreign.ForeignPtr as F
import qualified Foreign.Ptr as F
#include "repa-convert.h"
data MaybeChars f = MaybeChars String f deriving (Eq, Show)
instance Format f => Format (MaybeChars f) where
type Value (MaybeChars f)
= Maybe (Value f)
fieldCount _
= 1
minSize (MaybeChars str f)
= minSize (MaybeBytes (BS.pack str) f)
fixedSize (MaybeChars str f)
= fixedSize (MaybeBytes (BS.pack str) f)
packedSize (MaybeChars str f)
= kk
where !bs = BS.pack str
kk mv
= packedSize (MaybeBytes bs f) mv
instance Packable f
=> Packable (MaybeChars f) where
packer (MaybeChars str f)
= kk
where !bs = BS.pack str
kk x start k
= packer (MaybeBytes bs f) x start k
instance Unpackable f
=> Unpackable (MaybeChars f) where
unpacker (MaybeChars str f)
= kk
where !bs = BS.pack str
kk start end stop fail eat
= unpacker (MaybeBytes bs f) start end stop fail eat
data MaybeBytes f = MaybeBytes ByteString f deriving (Eq, Show)
instance Format f => Format (MaybeBytes f) where
type Value (MaybeBytes f)
= Maybe (Value f)
fieldCount _
= 1
minSize (MaybeBytes str f)
= let !(I# ms) = minSize f
in I# (minSize_MaybeBytes str ms)
fixedSize (MaybeBytes str f)
= fixedSize_MaybeBytes str (fixedSize f)
packedSize (MaybeBytes str f) mv
= case mv of
Nothing -> Just $ BS.length str
Just v -> packedSize f v
minSize_MaybeBytes :: ByteString -> Int# -> Int#
minSize_MaybeBytes s i
= case min (BS.length s) (I# i) of
I# i' -> i'
fixedSize_MaybeBytes :: ByteString -> Maybe Int -> Maybe Int
fixedSize_MaybeBytes s r
= case r of
Nothing -> Nothing
Just sf -> if BS.length s == sf
then Just sf
else Nothing
instance Packable f
=> Packable (MaybeBytes f) where
packer (MaybeBytes str f) mv start k
= case mv of
Nothing -> packer VarBytes str start k
Just v -> packer f v start k
instance Unpackable f
=> Unpackable (MaybeBytes f) where
unpacker (MaybeBytes (BS.PS bsFptr bsStart bsLen) f)
start end stop fail eat
= F.withForeignPtr bsFptr
$ \bsPtr_
-> let
!lenBuf = F.minusPtr (pw8 end) (pw8 start)
!bsPtr = F.plusPtr bsPtr_ bsStart
checkNothing !ix
| ix >= bsLen
= do
let !(Ptr start') = F.plusPtr (pw8 start) ix
eatIt start' Nothing
| bsLen == 0
, ix >= lenBuf
= do let !(Ptr start') = F.plusPtr (pw8 start) ix
eatIt start' Nothing
| ix >= lenBuf
= unpackInner
| otherwise
= do !x <- F.peekByteOff (pw8 start) ix
if stop x
then unpackInner
else do
!x' <- F.peekByteOff bsPtr ix
if x /= x'
then unpackInner
else checkNothing (ix + 1)
unpackInner
= unpacker f start end stop fail
$ \addr x -> eatIt addr (Just x)
eatIt addr val
= eat addr val
in checkNothing 0
pw8 :: Addr# -> Ptr Word8
pw8 addr = Ptr addr