module Data.Repa.Convert.Format.Sep
        ( Sep       (..)
        , SepFormat (..)
        , SepMeta   (..))
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.Repa.Scalar.Product
import Data.Monoid
import Data.Word
import Data.Char
import GHC.Exts
import Prelude hiding (fail)
#include "repa-convert.h"


-- | Separate fields with the given character.
--
--   * The separating character is un-escapable. 
--   * The format @(Sep ',')@ does NOT parse a CSV
--     file according to the CSV specification: http://tools.ietf.org/html/rfc4180.
--
--   * The type is kept abstract as we cache some pre-computed values
--     we use to unpack this format. Use `mkSep` to make one.
--
data Sep f where
        SepNil  :: Sep ()

        SepCons :: {-# UNPACK #-} !SepMeta      -- Meta data about this format.
                -> !f                           -- Format of head field.
                -> Sep fs                       -- Spec for rest of fields.
                -> Sep (f :*: fs)


-- | Precomputed information about this format.
data SepMeta
        = SepMeta
        { -- | Length of this format, in fields.
          SepMeta -> Int
smFieldCount          :: !Int

          -- | Minimum length of this format, in bytes.
        , SepMeta -> Int
smMinSize             :: !Int

          -- | Fixed size of this format.
        , SepMeta -> Maybe Int
smFixedSize           :: !(Maybe Int)

          -- | Separating charater for this format.
        , SepMeta -> Char
smSepChar             :: !Char }


---------------------------------------------------------------------------------------------------
class SepFormat f where
 mkSep          :: Char -> f -> Sep f
 takeSepChar    :: Sep f -> Maybe Char

instance SepFormat () where
 mkSep :: Char -> () -> Sep ()
mkSep Char
_ () = Sep ()
SepNil
 {-# INLINE mkSep #-}

 takeSepChar :: Sep () -> Maybe Char
takeSepChar Sep ()
_  = Maybe Char
forall a. Maybe a
Nothing
 {-# INLINE takeSepChar #-}


instance (Format f1, SepFormat fs)
      => SepFormat (f1 :*: fs) where

 mkSep :: Char -> (f1 :*: fs) -> Sep (f1 :*: fs)
mkSep Char
c (f1
f1 :*: fs
fs)
  = case Char -> fs -> Sep fs
forall f. SepFormat f => Char -> f -> Sep f
mkSep Char
c fs
fs of
        Sep fs
SepNil
         -> SepMeta -> f1 -> Sep fs -> Sep (f1 :*: fs)
forall f fs. SepMeta -> f -> Sep fs -> Sep (f :*: fs)
SepCons 
                (SepMeta { smFieldCount :: Int
smFieldCount  = Int
1
                         , smMinSize :: Int
smMinSize     = f1 -> Int
forall f. Format f => f -> Int
minSize f1
f1
                         , smFixedSize :: Maybe Int
smFixedSize   = f1 -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize f1
f1
                         , smSepChar :: Char
smSepChar     = Char
c })
                f1
f1 Sep fs
Sep ()
SepNil

        sep :: Sep fs
sep@(SepCons SepMeta
sm f
_ Sep fs
_)
         -> SepMeta -> f1 -> Sep fs -> Sep (f1 :*: fs)
forall f fs. SepMeta -> f -> Sep fs -> Sep (f :*: fs)
SepCons
                (SepMeta { smFieldCount :: Int
smFieldCount  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SepMeta -> Int
smFieldCount SepMeta
sm
                         , smMinSize :: Int
smMinSize     = f1 -> Int
forall f. Format f => f -> Int
minSize f1
f1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SepMeta -> Int
smMinSize SepMeta
sm

                         , smFixedSize :: Maybe Int
smFixedSize   
                            = do Int
s1     <- f1 -> Maybe Int
forall f. Format f => f -> Maybe Int
fixedSize f1
f1
                                 Int
ss     <- SepMeta -> Maybe Int
smFixedSize SepMeta
sm
                                 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
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ss

                         , smSepChar :: Char
smSepChar     = Char
c })
                f1
f1 Sep fs
sep
 {-# INLINE mkSep #-}

 takeSepChar :: Sep (f1 :*: fs) -> Maybe Char
takeSepChar (SepCons SepMeta
sm f
_ Sep fs
_)
  = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ SepMeta -> Char
smSepChar SepMeta
sm
 {-# INLINE takeSepChar #-}


---------------------------------------------------------------------------------------------------
instance Format (Sep ()) where
 type Value (Sep ())    = ()
 fieldCount :: Sep () -> Int
fieldCount Sep ()
SepNil      = Int
0
 minSize :: Sep () -> Int
minSize    Sep ()
SepNil      = Int
0
 fixedSize :: Sep () -> Maybe Int
fixedSize  Sep ()
SepNil      = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
 packedSize :: Sep () -> Value (Sep ()) -> Maybe Int
packedSize Sep ()
SepNil Value (Sep ())
_    = Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable (Sep ()) where
 packer :: Sep ()
-> Value (Sep ()) -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer   Sep ()
_fmt Value (Sep ())
_val Addr#
dst IO ()
_fails Addr# -> IO ()
k    
  = Addr# -> IO ()
k Addr#
dst
 {-# INLINE packer #-}


instance Unpackable (Sep ()) where
 unpacker :: Sep ()
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (Sep ()) -> IO ())
-> IO ()
unpacker Sep ()
_fmt Addr#
start Addr#
_end Word8 -> Bool
_stop IO ()
_fail Addr# -> Value (Sep ()) -> IO ()
eat
  = Addr# -> Value (Sep ()) -> IO ()
eat Addr#
start ()
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
instance ( Format f1, Format (Sep fs)
         , Value (Sep fs) ~ Value fs)
        => Format (Sep (f1 :*: fs)) where

 type Value (Sep (f1 :*: fs)) 
        = Value f1 :*: Value fs

 fieldCount :: Sep (f1 :*: fs) -> Int
fieldCount (SepCons SepMeta
sm f
_f1 Sep fs
_sfs)
  = SepMeta -> Int
smFieldCount SepMeta
sm
 {-# INLINE fieldCount #-}

 minSize :: Sep (f1 :*: fs) -> Int
minSize    (SepCons SepMeta
sm f
_f1 Sep fs
_sfs)
  = SepMeta -> Int
smMinSize SepMeta
sm
 {-# INLINE minSize #-}

 fixedSize :: Sep (f1 :*: fs) -> Maybe Int
fixedSize  (SepCons SepMeta
sm f
_f1 Sep fs
_sfs)
  = SepMeta -> Maybe Int
smFixedSize SepMeta
sm
 {-# INLINE fixedSize #-}

 packedSize :: Sep (f1 :*: fs) -> Value (Sep (f1 :*: fs)) -> Maybe Int
packedSize (SepCons SepMeta
_sm f
f1 Sep fs
sfs) (Value f1
x1 :*: Value fs
xs)
  = do  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       <- Sep fs -> Value (Sep fs) -> Maybe Int
forall f. Format f => f -> Value f -> Maybe Int
packedSize Sep fs
sfs Value fs
Value (Sep fs)
xs
        let sSep :: Int
sSep =  Int -> Int
zeroOrOne (Sep fs -> Int
forall f. Format f => f -> Int
fieldCount Sep fs
sfs)
        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
sSep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ss 
 {-# INLINE packedSize #-}


---------------------------------------------------------------------------------------------------
instance ( Packable f1
         , Value (Sep ()) ~ Value ())
       => Packable (Sep (f1 :*: ())) where

 packer :: Sep (f1 :*: ())
-> Value (Sep (f1 :*: ()))
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer (SepCons SepMeta
_ f
f1 Sep fs
_ ) (Value f1
x1 :*: ()
_) Addr#
start IO ()
k
        = f -> Value f -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer f
f1 Value f1
Value f
x1 Addr#
start IO ()
k
 {-# INLINE packer #-}


instance ( Unpackable f1
         , Value (Sep ()) ~ Value ())
       => Unpackable (Sep (f1 :*: ())) where

 unpacker :: Sep (f1 :*: ())
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (Sep (f1 :*: ())) -> IO ())
-> IO ()
unpacker (SepCons SepMeta
sm f
f1 Sep fs
sfs) Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value (Sep (f1 :*: ())) -> IO ()
eat
  = do  let stop' :: Word8 -> Bool
stop' Word8
x = Int -> Word8
forall a. Integral a => a -> Word8
w8 (Char -> Int
ord (SepMeta -> Char
smSepChar SepMeta
sm)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
stop Word8
x
            {-# INLINE stop' #-}

        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
f1  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#
start_x1 Value f
x1
         -> Sep fs
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (Sep fs) -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Sep fs
sfs Addr#
start_x1 Addr#
end Word8 -> Bool
stop  IO ()
fail ((Addr# -> Value (Sep fs) -> IO ()) -> IO ())
-> (Addr# -> Value (Sep fs) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_xs Value (Sep fs)
xs
             -> Addr# -> Value (Sep (f1 :*: ())) -> IO ()
eat Addr#
start_xs (Value f1
Value f
x1 Value f1 -> () -> Value f1 :*: ()
forall a b. a -> b -> a :*: b
:*: ()
Value (Sep fs)
xs)
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
instance ( Packable f1
         , Packable (Sep (f2 :*: fs))
         , Value    (Sep (f2 :*: fs)) ~ Value (f2 :*: fs)
         , Value    (Sep fs)          ~ Value fs)
      => Packable   (Sep (f1 :*: f2 :*: fs)) where

 pack :: Sep (f1 :*: (f2 :*: fs))
-> Value (Sep (f1 :*: (f2 :*: fs))) -> Packer
pack (SepCons SepMeta
sm f
f1 Sep fs
sfs) (Value f1
x1 :*: Value f2 :*: Value fs
xs)
        =  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 -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ SepMeta -> Char
smSepChar SepMeta
sm) 
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Sep fs -> Value (Sep fs) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Sep fs
sfs Value f2 :*: Value fs
Value (Sep fs)
xs
 {-# INLINE pack #-}

 packer :: Sep (f1 :*: (f2 :*: fs))
-> Value (Sep (f1 :*: (f2 :*: fs)))
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer Sep (f1 :*: (f2 :*: fs))
f Value (Sep (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
$ Sep (f1 :*: (f2 :*: fs))
-> Value (Sep (f1 :*: (f2 :*: fs))) -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Sep (f1 :*: (f2 :*: fs))
f Value (Sep (f1 :*: (f2 :*: fs)))
v
 {-# INLINE packer #-}


instance ( Unpackable f1
         , Unpackable (Sep (f2 :*: fs))
         , Value    (Sep (f2 :*: fs)) ~ Value (f2 :*: fs)
         , Value    (Sep fs)          ~ Value fs)
      => Unpackable   (Sep (f1 :*: f2 :*: fs)) where

 unpacker :: Sep (f1 :*: (f2 :*: fs))
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (Sep (f1 :*: (f2 :*: fs))) -> IO ())
-> IO ()
unpacker (SepCons SepMeta
sm f
f1 Sep fs
sfs) Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value (Sep (f1 :*: (f2 :*: fs))) -> IO ()
eat
  = do  -- Length of data remaining in the input buffer.
        let len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start)

        let stop' :: Word8 -> Bool
stop' Word8
x = Int -> Word8
forall a. Integral a => a -> Word8
w8 (Char -> Int
ord (SepMeta -> Char
smSepChar SepMeta
sm)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
stop Word8
x
            {-# INLINE stop' #-}

        if Bool -> Bool
not (SepMeta -> Int
smMinSize SepMeta
sm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len)
         then IO ()
fail
         else do
                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
f1  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#
start_x1 Value f
x1 
                 -> Sep fs
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value (Sep fs) -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Sep fs
sfs (Addr# -> Int# -> Addr#
plusAddr# Addr#
start_x1 Int#
1#) Addr#
end Word8 -> Bool
stop  IO ()
fail ((Addr# -> Value (Sep fs) -> IO ()) -> IO ())
-> (Addr# -> Value (Sep fs) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_xs Value (Sep fs)
xs
                     -> Addr# -> Value (Sep (f1 :*: (f2 :*: fs))) -> IO ()
eat Addr#
start_xs (Value f1
Value f
x1 Value f1
-> (Value f2 :*: Value fs) -> Value f1 :*: (Value f2 :*: Value fs)
forall a b. a -> b -> a :*: b
:*: Value f2 :*: Value fs
Value (Sep fs)
xs)
 {-# INLINE 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  #-}


-- | Branchless equality used to avoid compile-time explosion in size of core code.
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 #-}