-- | Conversions for "Data.Maybe" wrapped formats.
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"


---------------------------------------------------------------------------------------- MaybeChars
-- | Maybe a raw list of characters, or something else.
data MaybeChars f            = MaybeChars String f      deriving (MaybeChars f -> MaybeChars f -> Bool
(MaybeChars f -> MaybeChars f -> Bool)
-> (MaybeChars f -> MaybeChars f -> Bool) -> Eq (MaybeChars f)
forall f. Eq f => MaybeChars f -> MaybeChars f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall f. Eq f => MaybeChars f -> MaybeChars f -> Bool
== :: MaybeChars f -> MaybeChars f -> Bool
$c/= :: forall f. Eq f => MaybeChars f -> MaybeChars f -> Bool
/= :: MaybeChars f -> MaybeChars f -> Bool
Eq, Int -> MaybeChars f -> ShowS
[MaybeChars f] -> ShowS
MaybeChars f -> String
(Int -> MaybeChars f -> ShowS)
-> (MaybeChars f -> String)
-> ([MaybeChars f] -> ShowS)
-> Show (MaybeChars f)
forall f. Show f => Int -> MaybeChars f -> ShowS
forall f. Show f => [MaybeChars f] -> ShowS
forall f. Show f => MaybeChars f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall f. Show f => Int -> MaybeChars f -> ShowS
showsPrec :: Int -> MaybeChars f -> ShowS
$cshow :: forall f. Show f => MaybeChars f -> String
show :: MaybeChars f -> String
$cshowList :: forall f. Show f => [MaybeChars f] -> ShowS
showList :: [MaybeChars f] -> ShowS
Show)

instance Format f => Format (MaybeChars f) where
 type Value (MaybeChars f)   
        = Maybe (Value f)

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

 minSize :: MaybeChars f -> Int
minSize       (MaybeChars String
str f
f) 
  = MaybeBytes f -> Int
forall f. Format f => f -> Int
minSize    (ByteString -> f -> MaybeBytes f
forall f. ByteString -> f -> MaybeBytes f
MaybeBytes (String -> ByteString
BS.pack String
str) f
f)

 {-# INLINE minSize    #-}

 fixedSize :: MaybeChars f -> Maybe Int
fixedSize     (MaybeChars String
str f
f)
  = MaybeBytes f -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize  (ByteString -> f -> MaybeBytes f
forall f. ByteString -> f -> MaybeBytes f
MaybeBytes (String -> ByteString
BS.pack String
str) f
f)
 {-# INLINE fixedSize #-}

 packedSize :: MaybeChars f -> Value (MaybeChars f) -> Maybe Int
packedSize    (MaybeChars String
str f
f) 
  = Maybe (Value f) -> Maybe Int
Value (MaybeChars f) -> Maybe Int
kk
  where !bs :: ByteString
bs = String -> ByteString
BS.pack String
str
        kk :: Maybe (Value f) -> Maybe Int
kk Maybe (Value f)
mv
         = MaybeBytes f -> Value (MaybeBytes f) -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize (ByteString -> f -> MaybeBytes f
forall f. ByteString -> f -> MaybeBytes f
MaybeBytes ByteString
bs f
f) Maybe (Value f)
Value (MaybeBytes f)
mv
        {-# INLINE kk #-}
 {-# INLINE packedSize #-}


instance Packable f
      => Packable (MaybeChars f) where

 -- Convert the Nothing string to a ByteString which has a better runtime representation.
 -- We do this before accepting the actual value, so the conversion happens only
 -- once, instead of when we pack every value.
 packer :: MaybeChars f
-> Value (MaybeChars f)
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer    (MaybeChars String
str f
f)
  = Maybe (Value f) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
Value (MaybeChars f) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
kk
  where !bs :: ByteString
bs = String -> ByteString
BS.pack String
str
        kk :: Maybe (Value f) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
kk Maybe (Value f)
x Addr#
start IO ()
k
         = MaybeBytes f
-> Value (MaybeBytes f)
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer  (ByteString -> f -> MaybeBytes f
forall f. ByteString -> f -> MaybeBytes f
MaybeBytes ByteString
bs f
f) Maybe (Value f)
Value (MaybeBytes f)
x Addr#
start IO ()
k
        {-# INLINE kk #-}
 {-# INLINE packer #-}


instance Unpackable f
      => Unpackable (MaybeChars f) where

 -- As above, convert the Nothing string to a ByteString which has a better runtime
 -- representation.
 unpacker :: MaybeChars f
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (MaybeChars f) -> IO ())
-> IO ()
unpacker  (MaybeChars String
str f
f)
  = Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Maybe (Value f) -> IO ())
-> IO ()
Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (MaybeChars f) -> IO ())
-> IO ()
kk
  where !bs :: ByteString
bs = String -> ByteString
BS.pack String
str
        kk :: Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Maybe (Value f) -> IO ())
-> IO ()
kk Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Maybe (Value f) -> IO ()
eat
         = MaybeBytes f
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (MaybeBytes f) -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker (ByteString -> f -> MaybeBytes f
forall f. ByteString -> f -> MaybeBytes f
MaybeBytes ByteString
bs f
f) Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Maybe (Value f) -> IO ()
Addr# -> Value (MaybeBytes f) -> IO ()
eat
        {-# INLINE kk #-}
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------- MaybeBytes
-- | Maybe a raw sequence of bytes, or something else.
data MaybeBytes f           = MaybeBytes ByteString f   deriving (MaybeBytes f -> MaybeBytes f -> Bool
(MaybeBytes f -> MaybeBytes f -> Bool)
-> (MaybeBytes f -> MaybeBytes f -> Bool) -> Eq (MaybeBytes f)
forall f. Eq f => MaybeBytes f -> MaybeBytes f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall f. Eq f => MaybeBytes f -> MaybeBytes f -> Bool
== :: MaybeBytes f -> MaybeBytes f -> Bool
$c/= :: forall f. Eq f => MaybeBytes f -> MaybeBytes f -> Bool
/= :: MaybeBytes f -> MaybeBytes f -> Bool
Eq, Int -> MaybeBytes f -> ShowS
[MaybeBytes f] -> ShowS
MaybeBytes f -> String
(Int -> MaybeBytes f -> ShowS)
-> (MaybeBytes f -> String)
-> ([MaybeBytes f] -> ShowS)
-> Show (MaybeBytes f)
forall f. Show f => Int -> MaybeBytes f -> ShowS
forall f. Show f => [MaybeBytes f] -> ShowS
forall f. Show f => MaybeBytes f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall f. Show f => Int -> MaybeBytes f -> ShowS
showsPrec :: Int -> MaybeBytes f -> ShowS
$cshow :: forall f. Show f => MaybeBytes f -> String
show :: MaybeBytes f -> String
$cshowList :: forall f. Show f => [MaybeBytes f] -> ShowS
showList :: [MaybeBytes f] -> ShowS
Show)

instance Format f => Format (MaybeBytes f) where

 type Value (MaybeBytes f)   
        = Maybe (Value f)

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

 minSize :: MaybeBytes f -> Int
minSize    (MaybeBytes ByteString
str f
f) 
  = let !(I# Int#
ms)   = f -> Int
forall f. Format f => f -> Int
minSize f
f
    in  Int# -> Int
I# (ByteString -> Int# -> Int#
minSize_MaybeBytes ByteString
str Int#
ms)
 {-# INLINE minSize    #-}

 fixedSize :: MaybeBytes f -> Maybe Int
fixedSize  (MaybeBytes ByteString
str f
f)
  = ByteString -> Maybe Int -> Maybe Int
fixedSize_MaybeBytes ByteString
str (f -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize f
f) 
 {-# INLINE fixedSize #-}

 packedSize :: MaybeBytes f -> Value (MaybeBytes f) -> Maybe Int
packedSize (MaybeBytes ByteString
str f
f) Value (MaybeBytes f)
mv
  = case Value (MaybeBytes f)
mv of
        Maybe (Value f)
Value (MaybeBytes f)
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str
        Just Value f
v  -> f -> Value f -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize f
f Value f
v
 {-# NOINLINE packedSize #-}
 --  NOINLINE to hide the case from the simplifier.


-- Minsize, hiding the case expression from the simplifier.
minSize_MaybeBytes   :: ByteString -> Int# -> Int#
minSize_MaybeBytes :: ByteString -> Int# -> Int#
minSize_MaybeBytes ByteString
s Int#
i
 = case Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (ByteString -> Int
BS.length ByteString
s) (Int# -> Int
I# Int#
i) of
        I# Int#
i' -> Int#
i'
{-# NOINLINE minSize_MaybeBytes #-}


-- Fixedsize, hiding the case expression from the simplifier.
fixedSize_MaybeBytes :: ByteString -> Maybe Int -> Maybe Int
fixedSize_MaybeBytes :: ByteString -> Maybe Int -> Maybe Int
fixedSize_MaybeBytes ByteString
s Maybe Int
r
 = case Maybe Int
r of
        Maybe Int
Nothing -> Maybe Int
forall a. Maybe a
Nothing
        Just Int
sf -> if ByteString -> Int
BS.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sf 
                        then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sf
                        else Maybe Int
forall a. Maybe a
Nothing
{-# NOINLINE fixedSize_MaybeBytes #-}
--  NOINLINE to hide the case from the simplifier.


instance Packable f
      => Packable (MaybeBytes f) where

 packer :: MaybeBytes f
-> Value (MaybeBytes f)
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer   (MaybeBytes ByteString
str f
f) Value (MaybeBytes f)
mv Addr#
start IO ()
k
  = case Value (MaybeBytes f)
mv of
        Maybe (Value f)
Value (MaybeBytes f)
Nothing -> VarBytes
-> Value VarBytes -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer VarBytes
VarBytes ByteString
Value VarBytes
str Addr#
start IO ()
k
        Just Value f
v  -> f -> Value f -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer f
f        Value f
v   Addr#
start IO ()
k
 {-# NOINLINE packer #-}
  -- We're NOINLINEing this so we don't duplicate the code for the continuation.
  -- It would be better to use an Either format and use that to express the branch.


instance Unpackable f
      => Unpackable (MaybeBytes f) where

 unpacker :: MaybeBytes f
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (MaybeBytes f) -> IO ())
-> IO ()
unpacker (MaybeBytes (BS.PS ForeignPtr Word8
bsFptr Int
bsStart Int
bsLen) f
f) 
          Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value (MaybeBytes f) -> IO ()
eat
  = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
bsFptr
  ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bsPtr_
  -> let
        -- 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)

        -- Pointer to active bytes in Nothing string.
        !bsPtr :: Ptr Any
bsPtr  = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Word8
bsPtr_ Int
bsStart

        -- Check for the Nothing string,
        --   We do an early exit, bailing out on the first byte that doesn't match.
        --   If this isn't the Nothing string then we need to unpack the inner format.
        checkNothing :: Int -> IO ()
checkNothing !Int
ix

         -- Matched the complete Nothing string.
         | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bsLen
         = do   -- Give the continuation the starting pointer for the next field.
                let !(Ptr Addr#
start') = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Word8
pw8 Addr#
start) Int
ix
                Addr# -> Maybe (Value f) -> IO ()
eatIt Addr#
start' Maybe (Value f)
forall a. Maybe a
Nothing

         -- Hit the end of the buffer and the Nothing string itself is empty,
         -- which we count as detecting the Nothing string.
         | Int
bsLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
         , Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenBuf
         = do   let !(Ptr Addr#
start') = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Word8
pw8 Addr#
start) Int
ix
                Addr# -> Maybe (Value f) -> IO ()
eatIt Addr#
start' Maybe (Value f)
forall a. Maybe a
Nothing

         -- Hit the end of the buffer before matching the Nothing string.
         | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenBuf     
         = IO ()
unpackInner

         -- Check if the next byte is the next byte in the Nothing string.
         | 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 IO ()
unpackInner
                else do
                        !Word8
x'  <- Ptr Any -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff Ptr Any
bsPtr Int
ix
                        if Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
x'
                         then IO ()
unpackInner
                         else Int -> IO ()
checkNothing (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

        unpackInner :: IO ()
unpackInner 
         = f
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value f -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker f
f Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail 
         ((Addr# -> Value f -> IO ()) -> IO ())
-> (Addr# -> Value f -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value f
x -> Addr# -> Maybe (Value f) -> IO ()
eatIt Addr#
addr (Value f -> Maybe (Value f)
forall a. a -> Maybe a
Just Value f
x)
        {-# NOINLINE unpackInner #-}

        eatIt :: Addr# -> Maybe (Value f) -> IO ()
eatIt Addr#
addr Maybe (Value f)
val
         = Addr# -> Value (MaybeBytes f) -> IO ()
eat Addr#
addr Maybe (Value f)
Value (MaybeBytes f)
val
        {-# NOINLINE eatIt #-}
        --  NOINLINE so we don't duplicate the continuation.

     in Int -> IO ()
checkNothing Int
0
 {-# 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 #-}