-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Data.ByteString.Conversion.To
    ( ToByteString (..)
    , toByteString
    , toByteString'
    , runBuilder
    ) where

import Data.ByteString (ByteString)
import Data.ByteString.Conversion.Internal
import Data.ByteString.Builder
import Data.ByteString.Builder.Extra hiding (runBuilder)
import Data.CaseInsensitive (CI, original)
import Data.Int
import Data.List (intersperse)
import Data.Monoid
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Word
import GHC.Float (float2Double)

import qualified Data.ByteString.Lazy    as L
import qualified Data.Text               as T
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.Encoding as TL

#ifdef WINDOWS
import Blaze.Text.Double
#else
import Data.Double.Conversion.Text
#endif

class ToByteString a where
    builder :: a -> Builder

instance ToByteString Builder      where builder :: Builder -> Builder
builder Builder
x = Builder
x
instance ToByteString L.ByteString where builder :: ByteString -> Builder
builder ByteString
x = ByteString -> Builder
lazyByteString ByteString
x
instance ToByteString ByteString   where builder :: ByteString -> Builder
builder ByteString
x = ByteString -> Builder
byteString ByteString
x
instance ToByteString Text         where builder :: Text -> Builder
builder Text
x = ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
x
instance ToByteString TL.Text      where builder :: Text -> Builder
builder Text
x = ByteString -> Builder
lazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TL.encodeUtf8 Text
x
instance ToByteString Char         where builder :: Char -> Builder
builder Char
x = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
x
instance ToByteString [Char]       where builder :: [Char] -> Builder
builder [Char]
x = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
TL.pack [Char]
x
#ifdef WINDOWS
instance ToByteString Float        where builder x = double $ float2Double x
instance ToByteString Double       where builder x = double x
#else
instance ToByteString Float        where builder :: Float -> Builder
builder Float
x = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Double -> Text
toShortest (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Float -> Double
float2Double Float
x
instance ToByteString Double       where builder :: Double -> Builder
builder Double
x = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Double -> Text
toShortest Double
x
#endif

instance ToByteString Int          where builder :: Int -> Builder
builder Int
x = Int -> Builder
intDec Int
x
instance ToByteString Int8         where builder :: Int8 -> Builder
builder Int8
x = Int8 -> Builder
int8Dec Int8
x
instance ToByteString Int16        where builder :: Int16 -> Builder
builder Int16
x = Int16 -> Builder
int16Dec Int16
x
instance ToByteString Int32        where builder :: Int32 -> Builder
builder Int32
x = Int32 -> Builder
int32Dec Int32
x
instance ToByteString Int64        where builder :: Int64 -> Builder
builder Int64
x = Int64 -> Builder
int64Dec Int64
x
instance ToByteString Integer      where builder :: Integer -> Builder
builder Integer
x = Integer -> Builder
integerDec Integer
x
instance ToByteString Word         where builder :: Word -> Builder
builder Word
x = Word -> Builder
wordDec Word
x
instance ToByteString Word8        where builder :: Word8 -> Builder
builder Word8
x = Word8 -> Builder
word8Dec Word8
x
instance ToByteString Word16       where builder :: Word16 -> Builder
builder Word16
x = Word16 -> Builder
word16Dec Word16
x
instance ToByteString Word32       where builder :: Word32 -> Builder
builder Word32
x = Word32 -> Builder
word32Dec Word32
x
instance ToByteString Word64       where builder :: Word64 -> Builder
builder Word64
x = Word64 -> Builder
word64Dec Word64
x

instance ToByteString (Hex Int)    where builder :: Hex Int -> Builder
builder (Hex Int
x) = Int -> Builder
forall a. Integral a => a -> Builder
sign Int
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
wordHex (Int -> Word
forall a b. (Integral a, Integral b) => a -> b
toWord Int
x)
instance ToByteString (Hex Int8)   where builder :: Hex Int8 -> Builder
builder (Hex Int8
x) = Int8 -> Builder
forall a. Integral a => a -> Builder
sign Int8
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8Hex (Int8 -> Word8
forall a b. (Integral a, Integral b) => a -> b
toWord Int8
x)
instance ToByteString (Hex Int16)  where builder :: Hex Int16 -> Builder
builder (Hex Int16
x) = Int16 -> Builder
forall a. Integral a => a -> Builder
sign Int16
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Hex (Int16 -> Word16
forall a b. (Integral a, Integral b) => a -> b
toWord Int16
x)
instance ToByteString (Hex Int32)  where builder :: Hex Int32 -> Builder
builder (Hex Int32
x) = Int32 -> Builder
forall a. Integral a => a -> Builder
sign Int32
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Hex (Int32 -> Word32
forall a b. (Integral a, Integral b) => a -> b
toWord Int32
x)
instance ToByteString (Hex Int64)  where builder :: Hex Int64 -> Builder
builder (Hex Int64
x) = Int64 -> Builder
forall a. Integral a => a -> Builder
sign Int64
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Hex (Int64 -> Word64
forall a b. (Integral a, Integral b) => a -> b
toWord Int64
x)
instance ToByteString (Hex Word)   where builder :: Hex Word -> Builder
builder (Hex Word
x) = Word -> Builder
wordHex Word
x
instance ToByteString (Hex Word8)  where builder :: Hex Word8 -> Builder
builder (Hex Word8
x) = Word8 -> Builder
word8Hex Word8
x
instance ToByteString (Hex Word16) where builder :: Hex Word16 -> Builder
builder (Hex Word16
x) = Word16 -> Builder
word16Hex Word16
x
instance ToByteString (Hex Word32) where builder :: Hex Word32 -> Builder
builder (Hex Word32
x) = Word32 -> Builder
word32Hex Word32
x
instance ToByteString (Hex Word64) where builder :: Hex Word64 -> Builder
builder (Hex Word64
x) = Word64 -> Builder
word64Hex Word64
x

instance ToByteString a => ToByteString (List a) where
    builder :: List a -> Builder
builder = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (List a -> [Builder]) -> List a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
comma ([Builder] -> [Builder])
-> (List a -> [Builder]) -> List a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall a. ToByteString a => a -> Builder
builder ([a] -> [Builder]) -> (List a -> [a]) -> List a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List a -> [a]
forall a. List a -> [a]
fromList

instance ToByteString Bool where
    builder :: Bool -> Builder
builder Bool
True  = ByteString -> Builder
byteString ByteString
"true"
    builder Bool
False = ByteString -> Builder
byteString ByteString
"false"

instance ToByteString a => ToByteString (CI a) where
    builder :: CI a -> Builder
builder = a -> Builder
forall a. ToByteString a => a -> Builder
builder (a -> Builder) -> (CI a -> a) -> CI a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI a -> a
forall s. CI s -> s
original

toByteString :: ToByteString a => a -> L.ByteString
toByteString :: forall a. ToByteString a => a -> ByteString
toByteString = Builder -> ByteString
runBuilder (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. ToByteString a => a -> Builder
builder

-- | Please note that this needs to convert from a lazy 'L.ByteString' to
-- a strict one which involves copying the whole string.
toByteString' :: ToByteString a => a -> ByteString
toByteString' :: forall a. ToByteString a => a -> ByteString
toByteString' = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString

runBuilder :: Builder -> L.ByteString
runBuilder :: Builder -> ByteString
runBuilder = AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith (Int -> Int -> AllocationStrategy
safeStrategy Int
32 Int
smallChunkSize) ByteString
L.empty

sign :: Integral a => a -> Builder
sign :: forall a. Integral a => a -> Builder
sign a
n = if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then Builder
minus else Builder
forall a. Monoid a => a
mempty
{-# SPECIALISE sign :: Int   -> Builder #-}
{-# SPECIALISE sign :: Int8  -> Builder #-}
{-# SPECIALISE sign :: Int16 -> Builder #-}
{-# SPECIALISE sign :: Int32 -> Builder #-}
{-# SPECIALISE sign :: Int64 -> Builder #-}

toWord :: (Integral a, Integral b) => a -> b
toWord :: forall a b. (Integral a, Integral b) => a -> b
toWord = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
abs
{-# SPECIALISE toWord :: Int   -> Word   #-}
{-# SPECIALISE toWord :: Int8  -> Word8  #-}
{-# SPECIALISE toWord :: Int16 -> Word16 #-}
{-# SPECIALISE toWord :: Int32 -> Word32 #-}
{-# SPECIALISE toWord :: Int64 -> Word64 #-}

comma, minus :: Builder
comma :: Builder
comma = ByteString -> Builder
byteString ByteString
","
minus :: Builder
minus = ByteString -> Builder
byteString ByteString
"-"
{-# INLINE comma #-}
{-# INLINE minus #-}