module Text.Search.Sphinx.Put where

import Data.Int (Int64)
import Data.Binary (Word64)
import Data.Binary.Put
import Data.ByteString.Lazy hiding (pack, length, map, groupBy)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.ByteString.Lazy as BS
import qualified Text.Search.Sphinx.Types as T
import Data.Binary.IEEE754 

import Data.Text (Text)
import qualified Data.Text.ICU.Convert as ICU
import qualified Data.ByteString as Strict (length)

num :: Int -> Put
num     = Word32 -> Put
putWord32be (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
num64 :: a -> Put
num64 a
i = Word64 -> Put
putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i

float :: Float -> Put
float = Float -> Put
putFloat32be 

enum :: Enum a => a -> Put
enum :: forall a. Enum a => a -> Put
enum = Int -> Put
num (Int -> Put) -> (a -> Int) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum

list :: (a -> PutM b) -> t a -> Put
list a -> PutM b
f t a
ls = Int -> Put
num (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ls) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> PutM b) -> t a -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> PutM b
f t a
ls

numC :: t -> t (t -> Int) -> Put
numC   t
cfg = ((t -> Int) -> Put) -> t (t -> Int) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\t -> Int
x -> Int -> Put
num   (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ t -> Int
x t
cfg)
numC64 :: t -> t (t -> a) -> Put
numC64 t
cfg = ((t -> a) -> Put) -> t (t -> a) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\t -> a
x -> a -> Put
forall {a}. Integral a => a -> Put
num64 (a -> Put) -> a -> Put
forall a b. (a -> b) -> a -> b
$ t -> a
x t
cfg)
strC :: t -> t (t -> String) -> Put
strC   t
cfg = ((t -> String) -> Put) -> t (t -> String) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\t -> String
x -> String -> Put
str   (String -> Put) -> String -> Put
forall a b. (a -> b) -> a -> b
$ t -> String
x t
cfg)

stringIntList :: [(String, Int)] -> Put
stringIntList :: [(String, Int)] -> Put
stringIntList [(String, Int)]
xs = ((String, Int) -> Put) -> [(String, Int)] -> Put
forall {t :: * -> *} {a} {b}.
Foldable t =>
(a -> PutM b) -> t a -> Put
list (String, Int) -> Put
strInt [(String, Int)]
xs
 where strInt :: (String, Int) -> Put
strInt (String
s,Int
i) = String -> Put
str String
s Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
num Int
i

str :: String -> Put
str :: String -> Put
str String
s = do let bs :: ByteString
bs = String -> ByteString
pack String
s
           Int -> Put
num (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.length ByteString
bs)
           ByteString -> Put
putLazyByteString ByteString
bs

cmd :: T.SearchdCommand -> Put
cmd :: SearchdCommand -> Put
cmd = Word16 -> Put
putWord16be (Word16 -> Put)
-> (SearchdCommand -> Word16) -> SearchdCommand -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16)
-> (SearchdCommand -> Int) -> SearchdCommand -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchdCommand -> Int
T.searchdCommand

verCmd :: T.VerCommand -> Put
verCmd :: VerCommand -> Put
verCmd = Word16 -> Put
putWord16be (Word16 -> Put) -> (VerCommand -> Word16) -> VerCommand -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> (VerCommand -> Int) -> VerCommand -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerCommand -> Int
forall {a}. Num a => VerCommand -> a
T.verCommand

foldPuts :: [Put] -> Put
foldPuts :: [Put] -> Put
foldPuts [] = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foldPuts [Put
p] = Put
p
foldPuts (Put
p:[Put]
ps) = Put
p Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Put] -> Put
foldPuts [Put]
ps

txt :: ICU.Converter -> Text -> Put
txt :: Converter -> Text -> Put
txt Converter
conv Text
t = do let bs :: ByteString
bs = Converter -> Text -> ByteString
ICU.fromUnicode Converter
conv Text
t
                Int -> Put
num (Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Strict.length ByteString
bs)
                ByteString -> Put
putByteString ByteString
bs