-- | Convert tuples of Haskell values to and from ASCII or packed binary
--   representations.
--
--   This package is intended for cheap and cheerful serialisation and
--   deserialisation of flat tables, where each row has a fixed format.
--   If you have a table consisting of a couple hundred megs of
--   Pipe-Separated-Variables issued by some filthy enterprise system,
--   then this package is for you.
--
--   If you want to parse context-free, or context-sensitive
--   languages then try the @parsec@ or @attoparsec@ packages.
--   If you have binary data that does not have a fixed format then
--   try the @binary@ or @cereal@ packages.
--
--   For testing purposes, use `packToString` which takes a format,
--   a record, and returns a list of bytes.
--
-- @
-- > import Data.Repa.Convert
--
-- > let format   = mkSep '|' (VarChars :*: IntAsc :*: DoubleAsc :*: ())
-- > let Just str = packToString format ("foo" :*: 66 :*: 93.42 :*: ())
-- > str
-- "foo|66|93.42"
-- @
--
-- We can then unpack the raw bytes back to Haskell values with `unpackFromString`.
--
-- @
-- > unpackFromString format str 
-- Just ("foo" :*: (66 :*: (93.42 :*: ())))
-- @
--
-- In production code use `unsafeRunPacker` and `unsafeRunUnpacker` to work directly
-- with a buffer in foreign memory.
--
-- * NOTE that in the current version the separating character is un-escapable. 
-- * The above means that the format @(Sep ',')@ does NOT parse a CSV
--   file according to the CSV specification: http://tools.ietf.org/html/rfc4180.
--
module Data.Repa.Convert
        ( -- | The @Formats@ module contains the pre-defined data formats.
          module Data.Repa.Convert.Formats

          -- * Data formats  
        , Format    (..)

          -- * Type constraints
        , forFormat
        , listFormat

          -- * High-level interface
          -- ** for ByteStrings
        , packToByteString
        , unpackFromByteString

          -- ** for Lists of Word8
        , packToList8
        , unpackFromList8

          -- ** for Strings
        , packToString
        , unpackFromString

          -- * Low-level interface
          -- * Packing data
        , Packable  (..)
        , Packer    (..)
        , unsafeRunPacker

          -- * Unpacking data
        , Unpackable (..)
        , Unpacker   (..)
        , unsafeRunUnpacker)
where
import Data.Repa.Convert.Format
import Data.Repa.Convert.Formats
import Data.Word
import System.IO.Unsafe
import Data.IORef
import Data.ByteString                          (ByteString)
import qualified Data.ByteString.Internal       as BS
import qualified Data.ByteString                as BS
import qualified Data.ByteString.Char8          as BS8
import qualified Foreign.ForeignPtr             as F
import qualified Foreign.Marshal.Alloc          as F
import qualified Foreign.Marshal.Utils          as F
import qualified GHC.Ptr                        as F
#include "repa-convert.h"


---------------------------------------------------------------------------------------------------
-- | Constrain the type of a value to match the given format.
-- 
--   The value itself is not used.
--
forFormat :: format -> Value format  -> Value format
forFormat :: forall format. format -> Value format -> Value format
forFormat format
_ Value format
v = Value format
v
{-# INLINE forFormat #-}


-- | Constrain the type of some values to match the given format.
--
--   The value itself is not used.
--
listFormat :: format -> [Value format] -> [Value format]
listFormat :: forall format. format -> [Value format] -> [Value format]
listFormat format
_ [Value format]
v = [Value format]
v
{-# INLINE listFormat #-}


---------------------------------------------------------------------------------------------------
-- | Pack a value to a freshly allocated `ByteString`.
packToByteString
        :: Packable format
        => format -> Value format -> Maybe ByteString

packToByteString :: forall format.
Packable format =>
format -> Value format -> Maybe ByteString
packToByteString format
format Value format
value

 -- The size returned by `packedSize` is an over-approximation.
 --   As we don't want to waste space in the returned value, 
 --   we pack the value to a stack allocated buffer, 
 --   then copy it into a newly allocated ByteString when we know
 --   how much space we actually need.
 |  Just Int
lenMax <- format -> Value format -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize format
format Value format
value
 =  IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO
 (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$  Int
-> (Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes Int
lenMax ((Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf
 -> do
        -- Pack the value into the on-stack buffer.
        let !(F.Ptr Addr#
addr) = Ptr Word8
buf
        !IORef (Maybe (Ptr Any))
ref    <- Maybe (Ptr Any) -> IO (IORef (Maybe (Ptr Any)))
forall a. a -> IO (IORef a)
newIORef Maybe (Ptr Any)
forall a. Maybe a
Nothing
        format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer format
format Value format
value Addr#
addr
                (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                (\Addr#
buf' -> IORef (Maybe (Ptr Any)) -> Maybe (Ptr Any) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Ptr Any))
ref (Ptr Any -> Maybe (Ptr Any)
forall a. a -> Maybe a
Just (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
F.Ptr Addr#
buf')))
        Maybe (Ptr Any)
mEnd    <- IORef (Maybe (Ptr Any)) -> IO (Maybe (Ptr Any))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Ptr Any))
ref

        -- See if the packer worked.
        case Maybe (Ptr Any)
mEnd of
         Just Ptr Any
end
          -> do -- Now work out how much space we actually used.
                let !lenPacked :: Int
lenPacked = Ptr Any -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
F.minusPtr Ptr Any
end Ptr Word8
buf

                -- Allocate a new buffer of the right size, 
                -- and copy the data into it.
                Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
lenPacked IO (ForeignPtr Word8)
-> (ForeignPtr Word8 -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ForeignPtr Word8
fptr
                 -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr
                 -> do  Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
F.copyBytes Ptr Word8
ptr Ptr Word8
buf Int
lenPacked
                        Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fptr Int
0 Int
lenPacked

         Maybe (Ptr Any)
Nothing
          -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing

 | Bool
otherwise
 = Maybe ByteString
forall a. Maybe a
Nothing
{-# INLINE packToByteString #-}


-- | Unpack a value from a `ByteString`.
unpackFromByteString
        :: Unpackable format
        => format -> ByteString -> Maybe (Value format)

unpackFromByteString :: forall format.
Unpackable format =>
format -> ByteString -> Maybe (Value format)
unpackFromByteString format
format (BS.PS ForeignPtr Word8
fptr Int
offset Int
len)
 -- If the bytestring is too short to hold a value of the minimum
 -- size then we're going to have a bad time.
 | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< format -> Int
forall f. Format f => f -> Int
minSize format
format
 = Maybe (Value format)
forall a. Maybe a
Nothing

 -- Open up the bytestring and try to unpack its contents.
 | Bool
otherwise
 = IO (Maybe (Value format)) -> Maybe (Value format)
forall a. IO a -> a
unsafePerformIO
 (IO (Maybe (Value format)) -> Maybe (Value format))
-> IO (Maybe (Value format)) -> Maybe (Value format)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe (Value format)))
-> IO (Maybe (Value format))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Maybe (Value format)))
 -> IO (Maybe (Value format)))
-> (Ptr Word8 -> IO (Maybe (Value format)))
-> IO (Maybe (Value format))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr_
 -> do  
        let !(F.Ptr Addr#
start) = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Word8
ptr_  Int
offset
        let !(F.Ptr Addr#
end)   = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
F.Ptr Addr#
start) Int
len

        !IORef (Maybe (Ptr Any, Value format))
ref    <- Maybe (Ptr Any, Value format)
-> IO (IORef (Maybe (Ptr Any, Value format)))
forall a. a -> IO (IORef a)
newIORef Maybe (Ptr Any, Value format)
forall a. Maybe a
Nothing
        format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker format
format Addr#
start Addr#
end 
                (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
False)
                (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                (\Addr#
done' Value format
value -> IORef (Maybe (Ptr Any, Value format))
-> Maybe (Ptr Any, Value format) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Ptr Any, Value format))
ref (Maybe (Ptr Any, Value format) -> IO ())
-> Maybe (Ptr Any, Value format) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr Any, Value format) -> Maybe (Ptr Any, Value format)
forall a. a -> Maybe a
Just (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
F.Ptr Addr#
done', Value format
value))
        Maybe (Ptr Any, Value format)
mResult <- IORef (Maybe (Ptr Any, Value format))
-> IO (Maybe (Ptr Any, Value format))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Ptr Any, Value format))
ref

        Maybe (Value format) -> IO (Maybe (Value format))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Value format) -> IO (Maybe (Value format)))
-> Maybe (Value format) -> IO (Maybe (Value format))
forall a b. (a -> b) -> a -> b
$ case Maybe (Ptr Any, Value format)
mResult of
         Maybe (Ptr Any, Value format)
Nothing              -> Maybe (Value format)
forall a. Maybe a
Nothing
         Just (Ptr Any
done, Value format
value)
          | Ptr Any
done Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
/= Addr# -> Ptr Any
forall a. Addr# -> Ptr a
F.Ptr Addr#
end -> Maybe (Value format)
forall a. Maybe a
Nothing
          | Bool
otherwise         -> Value format -> Maybe (Value format)
forall a. a -> Maybe a
Just Value format
value
{-# INLINE unpackFromByteString #-}


---------------------------------------------------------------------------------------------------
-- | Pack a value to a list of `Word8`.
packToList8 
        :: Packable format
        => format -> Value format -> Maybe [Word8]
packToList8 :: forall format.
Packable format =>
format -> Value format -> Maybe [Word8]
packToList8 format
format Value format
value
 = (ByteString -> [Word8]) -> Maybe ByteString -> Maybe [Word8]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Word8]
BS.unpack (Maybe ByteString -> Maybe [Word8])
-> Maybe ByteString -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ format -> Value format -> Maybe ByteString
forall format.
Packable format =>
format -> Value format -> Maybe ByteString
packToByteString format
format Value format
value
{-# INLINE packToList8 #-}


-- | Unpack a value from a list of `Word8`.
unpackFromList8
        :: Unpackable format
        => format -> [Word8] -> Maybe (Value format)

unpackFromList8 :: forall format.
Unpackable format =>
format -> [Word8] -> Maybe (Value format)
unpackFromList8 format
format [Word8]
ws
 = format -> ByteString -> Maybe (Value format)
forall format.
Unpackable format =>
format -> ByteString -> Maybe (Value format)
unpackFromByteString format
format (ByteString -> Maybe (Value format))
-> ByteString -> Maybe (Value format)
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8]
ws
{-# INLINE unpackFromList8 #-}


---------------------------------------------------------------------------------------------------
-- | Pack a value to a (hated) Haskell `String`.
packToString
        :: Packable format
        => format -> Value format -> Maybe String
packToString :: forall format.
Packable format =>
format -> Value format -> Maybe String
packToString format
format Value format
value
 = (ByteString -> String) -> Maybe ByteString -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
BS8.unpack (Maybe ByteString -> Maybe String)
-> Maybe ByteString -> Maybe String
forall a b. (a -> b) -> a -> b
$ format -> Value format -> Maybe ByteString
forall format.
Packable format =>
format -> Value format -> Maybe ByteString
packToByteString format
format Value format
value
{-# INLINE packToString #-}


-- | Unpack a value from a (hated) Haskell `String`.
unpackFromString 
        :: Unpackable format
        => format -> String -> Maybe (Value format)
unpackFromString :: forall format.
Unpackable format =>
format -> String -> Maybe (Value format)
unpackFromString format
format String
ss
 = format -> ByteString -> Maybe (Value format)
forall format.
Unpackable format =>
format -> ByteString -> Maybe (Value format)
unpackFromByteString format
format (ByteString -> Maybe (Value format))
-> ByteString -> Maybe (Value format)
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack String
ss
{-# INLINE unpackFromString #-}