{-# LANGUAGE UndecidableInstances #-}
module Data.Repa.Convert.Format.Object
( Object (..)
, ObjectFormat
, ObjectFields
, Field (..)
, mkObject)
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Repa.Convert.Internal.Packer
import Data.Repa.Convert.Format.String
import Data.Repa.Convert.Format.Binary
import Data.Repa.Scalar.Product
import Data.Word
import Data.Char
import GHC.Exts
import Data.Text (Text)
import qualified Data.Text as T
data Object fields where
Object
:: ObjectFields fields
-> Object fields
data ObjectFields fields where
ObjectFieldsNil
:: ObjectFields ()
ObjectFieldsCons
:: {-# UNPACK #-} !ObjectMeta
-> !Text
-> !f
-> Maybe (Value f -> Bool)
-> ObjectFields fs
-> ObjectFields (f :*: fs)
data ObjectMeta
= ObjectMeta
{
ObjectMeta -> Int
omFieldCount :: !Int
, ObjectMeta -> Int
omMinSize :: !Int
, ObjectMeta -> Maybe Int
omFixedSize :: !(Maybe Int) }
mkObject :: ObjectFormat f
=> f -> Object (ObjectFormat' f)
mkObject :: forall f. ObjectFormat f => f -> Object (ObjectFormat' f)
mkObject f
f = ObjectFields (ObjectFormat' f) -> Object (ObjectFormat' f)
forall fields. ObjectFields fields -> Object fields
Object (f -> ObjectFields (ObjectFormat' f)
forall f. ObjectFormat f => f -> ObjectFields (ObjectFormat' f)
mkObjectFields f
f)
class ObjectFormat f where
type ObjectFormat' f
mkObjectFields :: f -> ObjectFields (ObjectFormat' f)
instance ObjectFormat () where
type ObjectFormat' () = ()
mkObjectFields :: () -> ObjectFields (ObjectFormat' ())
mkObjectFields () = ObjectFields ()
ObjectFields (ObjectFormat' ())
ObjectFieldsNil
{-# INLINE mkObjectFields #-}
data Field f
= Field
{ forall f. Field f -> String
fieldName :: String
, forall f. Field f -> f
fieldFormat :: f
, forall f. Field f -> Maybe (Value f -> Bool)
fieldInclude :: Maybe (Value f -> Bool) }
instance ( Format f1
, ObjectFormat fs)
=> ObjectFormat (Field f1 :*: fs) where
type ObjectFormat' (Field f1 :*: fs)
= f1 :*: ObjectFormat' fs
mkObjectFields :: (Field f1 :*: fs) -> ObjectFields (ObjectFormat' (Field f1 :*: fs))
mkObjectFields (Field String
label f1
f1 Maybe (Value f1 -> Bool)
mKeep :*: fs
fs)
= case fs -> ObjectFields (ObjectFormat' fs)
forall f. ObjectFormat f => f -> ObjectFields (ObjectFormat' f)
mkObjectFields fs
fs of
ObjectFields (ObjectFormat' fs)
ObjectFieldsNil
-> ObjectMeta
-> Text
-> f1
-> Maybe (Value f1 -> Bool)
-> ObjectFields ()
-> ObjectFields (f1 :*: ())
forall f fs.
ObjectMeta
-> Text
-> f
-> Maybe (Value f -> Bool)
-> ObjectFields fs
-> ObjectFields (f :*: fs)
ObjectFieldsCons
(ObjectMeta
{ omFieldCount :: Int
omFieldCount = Int
1
, omMinSize :: Int
omMinSize = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
label Int -> Int -> Int
forall a. Num a => a -> a -> a
+ f1 -> Int
forall f. Format f => f -> Int
minSize f1
f1
, omFixedSize :: Maybe Int
omFixedSize = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
label)) (Maybe Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ f1 -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize f1
f1 })
(String -> Text
T.pack String
label) f1
f1 Maybe (Value f1 -> Bool)
mKeep ObjectFields ()
ObjectFieldsNil
cc :: ObjectFields (ObjectFormat' fs)
cc@(ObjectFieldsCons ObjectMeta
jm Text
_ f
_ Maybe (Value f -> Bool)
_ ObjectFields fs
_)
-> ObjectMeta
-> Text
-> f1
-> Maybe (Value f1 -> Bool)
-> ObjectFields (f :*: fs)
-> ObjectFields (f1 :*: (f :*: fs))
forall f fs.
ObjectMeta
-> Text
-> f
-> Maybe (Value f -> Bool)
-> ObjectFields fs
-> ObjectFields (f :*: fs)
ObjectFieldsCons
(ObjectMeta
{ omFieldCount :: Int
omFieldCount = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ObjectMeta -> Int
omFieldCount ObjectMeta
jm
, omMinSize :: Int
omMinSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ f1 -> Int
forall f. Format f => f -> Int
minSize f1
f1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ObjectMeta -> Int
omMinSize ObjectMeta
jm
, omFixedSize :: Maybe Int
omFixedSize
= do Int
s1 <- f1 -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize f1
f1
Int
ss <- ObjectMeta -> Maybe Int
omFixedSize ObjectMeta
jm
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ss })
(String -> Text
T.pack String
label) f1
f1 Maybe (Value f1 -> Bool)
mKeep ObjectFields (f :*: fs)
ObjectFields (ObjectFormat' fs)
cc
{-# INLINE mkObjectFields #-}
instance ( Format (ObjectFields fs)
, Value (ObjectFields fs) ~ Value fs)
=> Format (Object fs) where
type Value (Object fs)
= Value fs
fieldCount :: Object fs -> Int
fieldCount (Object ObjectFields fs
_)
= Int
1
{-# INLINE fieldCount #-}
minSize :: Object fs -> Int
minSize (Object ObjectFields fs
fs)
= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ObjectFields fs -> Int
forall f. Format f => f -> Int
minSize ObjectFields fs
fs
{-# INLINE minSize #-}
fixedSize :: Object fs -> Maybe Int
fixedSize (Object ObjectFields fs
fs)
= do Int
sz <- ObjectFields fs -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize ObjectFields fs
fs
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz)
{-# INLINE fixedSize #-}
packedSize :: Object fs -> Value (Object fs) -> Maybe Int
packedSize (Object ObjectFields fs
fs) Value (Object fs)
xs
= do Int
ps <- ObjectFields fs -> Value (ObjectFields fs) -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize ObjectFields fs
fs Value (ObjectFields fs)
Value (Object fs)
xs
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ps
{-# INLINE packedSize #-}
instance Format (ObjectFields ()) where
type Value (ObjectFields ()) = ()
fieldCount :: ObjectFields () -> Int
fieldCount ObjectFields ()
ObjectFieldsNil = Int
0
minSize :: ObjectFields () -> Int
minSize ObjectFields ()
ObjectFieldsNil = Int
0
fixedSize :: ObjectFields () -> Maybe Int
fixedSize ObjectFields ()
ObjectFieldsNil = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
packedSize :: ObjectFields () -> Value (ObjectFields ()) -> Maybe Int
packedSize ObjectFields ()
ObjectFieldsNil Value (ObjectFields ())
_ = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
{-# INLINE fieldCount #-}
{-# INLINE minSize #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable (ObjectFields ()) where
packer :: ObjectFields ()
-> Value (ObjectFields ())
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer ObjectFields ()
_fmt Value (ObjectFields ())
_val Addr#
dst IO ()
_fails Addr# -> IO ()
k
= Addr# -> IO ()
k Addr#
dst
{-# INLINE packer #-}
instance Unpackable (ObjectFields ()) where
unpacker :: ObjectFields ()
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (ObjectFields ()) -> IO ())
-> IO ()
unpacker ObjectFields ()
_fmt Addr#
start Addr#
_end Word8 -> Bool
_stop IO ()
_fail Addr# -> Value (ObjectFields ()) -> IO ()
eat
= Addr# -> Value (ObjectFields ()) -> IO ()
eat Addr#
start ()
{-# INLINE unpacker #-}
instance ( Format f1, Format (ObjectFields fs)
, Value (ObjectFields fs) ~ Value fs)
=> Format (ObjectFields (f1 :*: fs)) where
type Value (ObjectFields (f1 :*: fs))
= Value f1 :*: Value fs
fieldCount :: ObjectFields (f1 :*: fs) -> Int
fieldCount (ObjectFieldsCons ObjectMeta
jm Text
_l1 f
_f1 Maybe (Value f -> Bool)
_keep ObjectFields fs
_jfs)
= ObjectMeta -> Int
omFieldCount ObjectMeta
jm
{-# INLINE fieldCount #-}
minSize :: ObjectFields (f1 :*: fs) -> Int
minSize (ObjectFieldsCons ObjectMeta
jm Text
_l1 f
_f1 Maybe (Value f -> Bool)
_keep ObjectFields fs
_jfs)
= ObjectMeta -> Int
omMinSize ObjectMeta
jm
{-# INLINE minSize #-}
fixedSize :: ObjectFields (f1 :*: fs) -> Maybe Int
fixedSize (ObjectFieldsCons ObjectMeta
jm Text
_l1 f
_f1 Maybe (Value f -> Bool)
_keep ObjectFields fs
_jfs)
= ObjectMeta -> Maybe Int
omFixedSize ObjectMeta
jm
{-# INLINE fixedSize #-}
packedSize :: ObjectFields (f1 :*: fs)
-> Value (ObjectFields (f1 :*: fs)) -> Maybe Int
packedSize (ObjectFieldsCons ObjectMeta
_jm Text
l1 f
f1 Maybe (Value f -> Bool)
_keep ObjectFields fs
jfs) (Value f1
x1 :*: Value fs
xs)
= do Int
sl <- VarCharString -> Value VarCharString -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize VarCharString
VarCharString (Text -> String
T.unpack Text
l1)
Int
s1 <- f -> Value f -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize f
f1 Value f1
Value f
x1
Int
ss <- ObjectFields fs -> Value (ObjectFields fs) -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize ObjectFields fs
jfs Value fs
Value (ObjectFields fs)
xs
let sSep :: Int
sSep = Int -> Int
zeroOrOne (ObjectFields fs -> Int
forall f. Format f => f -> Int
fieldCount ObjectFields fs
jfs)
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sSep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ss
{-# INLINE packedSize #-}
instance ( Format (Object f)
, Value (ObjectFields f) ~ Value f
, Packable (ObjectFields f))
=> Packable (Object f) where
pack :: Object f -> Value (Object f) -> Packer
pack (Object ObjectFields f
fs) Value (Object f)
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
'{')
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> ObjectFields f -> Value (ObjectFields f) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack ObjectFields f
fs Value (ObjectFields f)
Value (Object f)
xs
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> 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
'}')
{-# INLINE pack #-}
packer :: Object f
-> Value (Object f) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Object f
f Value (Object f)
v
= Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ())
-> Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Object f -> Value (Object f) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Object f
f Value (Object f)
v
{-# INLINE packer #-}
instance ( Packable f1
, Value (ObjectFields ()) ~ Value ())
=> Packable (ObjectFields (f1 :*: ())) where
pack :: ObjectFields (f1 :*: ())
-> Value (ObjectFields (f1 :*: ())) -> Packer
pack (ObjectFieldsCons ObjectMeta
_jm Text
l1 f
f1 Maybe (Value f -> Bool)
_keep ObjectFields fs
_jfs) (Value f1
x1 :*: ()
_)
= VarCharString -> Value VarCharString -> Packer
forall format. Packable format => format -> Value format -> Packer
pack VarCharString
VarCharString (Text -> String
T.unpack Text
l1)
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> 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
':')
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> f -> Value f -> Packer
forall format. Packable format => format -> Value format -> Packer
pack f
f1 Value f1
Value f
x1
{-# INLINE pack #-}
packer :: ObjectFields (f1 :*: ())
-> Value (ObjectFields (f1 :*: ()))
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer ObjectFields (f1 :*: ())
f Value (ObjectFields (f1 :*: ()))
v
= Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ())
-> Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ObjectFields (f1 :*: ())
-> Value (ObjectFields (f1 :*: ())) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack ObjectFields (f1 :*: ())
f Value (ObjectFields (f1 :*: ()))
v
{-# INLINE packer #-}
instance ( Packable f1
, Packable (ObjectFields (f2 :*: fs))
, Value (ObjectFields (f2 :*: fs)) ~ Value (f2 :*: fs)
, Value (ObjectFields fs) ~ Value fs)
=> Packable (ObjectFields (f1 :*: f2 :*: fs)) where
pack :: ObjectFields (f1 :*: (f2 :*: fs))
-> Value (ObjectFields (f1 :*: (f2 :*: fs))) -> Packer
pack (ObjectFieldsCons ObjectMeta
_jm Text
l1 f
f1 Maybe (Value f -> Bool)
mKeep ObjectFields fs
jfs) (Value f1
x1 :*: Value f2 :*: Value fs
xs)
= if (case Maybe (Value f -> Bool)
mKeep of
Just Value f -> Bool
keep -> Value f -> Bool
keep Value f1
Value f
x1
Maybe (Value f -> Bool)
_ -> Bool
True)
then Packer
here
else Packer
rest
where
here :: Packer
here = VarCharString -> Value VarCharString -> Packer
forall format. Packable format => format -> Value format -> Packer
pack VarCharString
VarCharString (Text -> String
T.unpack Text
l1)
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> 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
':')
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> f -> Value f -> Packer
forall format. Packable format => format -> Value format -> Packer
pack f
f1 Value f1
Value f
x1
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> 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
',')
Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Packer
rest
rest :: Packer
rest = ObjectFields fs -> Value (ObjectFields fs) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack ObjectFields fs
jfs Value f2 :*: Value fs
Value (ObjectFields fs)
xs
{-# INLINE pack #-}
packer :: ObjectFields (f1 :*: (f2 :*: fs))
-> Value (ObjectFields (f1 :*: (f2 :*: fs)))
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer ObjectFields (f1 :*: (f2 :*: fs))
f Value (ObjectFields (f1 :*: (f2 :*: fs)))
v
= Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ())
-> Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ObjectFields (f1 :*: (f2 :*: fs))
-> Value (ObjectFields (f1 :*: (f2 :*: fs))) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack ObjectFields (f1 :*: (f2 :*: fs))
f Value (ObjectFields (f1 :*: (f2 :*: fs)))
v
{-# INLINE packer #-}
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 #-}
zeroOrOne :: Int -> Int
zeroOrOne :: Int -> Int
zeroOrOne (I# Int#
i) = Int# -> Int
I# (Int#
1# Int# -> Int# -> Int#
-# (Int#
0# Int# -> Int# -> Int#
==# Int#
i))
{-# INLINE zeroOrOne #-}