1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE EmptyDataDecls #-} 3{-# LANGUAGE NoImplicitPrelude #-} 4{-# LANGUAGE OverloadedStrings #-} 5{-# LANGUAGE RankNTypes #-} 6 7module Data.Aeson.Encoding.Internal 8 ( 9 -- * Encoding 10 Encoding' (..) 11 , Encoding 12 , encodingToLazyByteString 13 , unsafeToEncoding 14 , retagEncoding 15 , Series (..) 16 , pairs 17 , pair 18 , pairStr 19 , pair' 20 -- * Predicates 21 , nullEncoding 22 -- * Encoding constructors 23 , emptyArray_ 24 , emptyObject_ 25 , wrapObject 26 , wrapArray 27 , null_ 28 , bool 29 , text 30 , lazyText 31 , string 32 , list 33 , dict 34 , tuple 35 , (>*<) 36 , InArray 37 , empty 38 , (><) 39 , econcat 40 -- ** Decimal numbers 41 , int8, int16, int32, int64, int 42 , word8, word16, word32, word64, word 43 , integer, float, double, scientific 44 -- ** Decimal numbers as Text 45 , int8Text, int16Text, int32Text, int64Text, intText 46 , word8Text, word16Text, word32Text, word64Text, wordText 47 , integerText, floatText, doubleText, scientificText 48 -- ** Time 49 , day 50 , localTime 51 , utcTime 52 , timeOfDay 53 , zonedTime 54 -- ** value 55 , value 56 -- ** JSON tokens 57 , comma, colon, openBracket, closeBracket, openCurly, closeCurly 58 ) where 59 60import Prelude.Compat 61 62import Data.Aeson.Types.Internal (Value) 63import Data.ByteString.Builder (Builder, char7, toLazyByteString) 64import Data.Int 65import Data.Scientific (Scientific) 66import Data.Text (Text) 67import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime) 68import Data.Typeable (Typeable) 69import Data.Word 70import qualified Data.Aeson.Encoding.Builder as EB 71import qualified Data.ByteString.Builder as B 72import qualified Data.ByteString.Lazy as BSL 73import qualified Data.Text.Lazy as LT 74 75-- | An encoding of a JSON value. 76-- 77-- @tag@ represents which kind of JSON the Encoding is encoding to, 78-- we reuse 'Text' and 'Value' as tags here. 79newtype Encoding' tag = Encoding { 80 fromEncoding :: Builder 81 -- ^ Acquire the underlying bytestring builder. 82 } deriving (Typeable) 83 84-- | Often used synonym for 'Encoding''. 85type Encoding = Encoding' Value 86 87-- | Make Encoding from Builder. 88-- 89-- Use with care! You have to make sure that the passed Builder 90-- is a valid JSON Encoding! 91unsafeToEncoding :: Builder -> Encoding' a 92unsafeToEncoding = Encoding 93 94encodingToLazyByteString :: Encoding' a -> BSL.ByteString 95encodingToLazyByteString = toLazyByteString . fromEncoding 96{-# INLINE encodingToLazyByteString #-} 97 98retagEncoding :: Encoding' a -> Encoding' b 99retagEncoding = Encoding . fromEncoding 100 101------------------------------------------------------------------------------- 102-- Encoding instances 103------------------------------------------------------------------------------- 104 105instance Show (Encoding' a) where 106 show (Encoding e) = show (toLazyByteString e) 107 108instance Eq (Encoding' a) where 109 Encoding a == Encoding b = toLazyByteString a == toLazyByteString b 110 111instance Ord (Encoding' a) where 112 compare (Encoding a) (Encoding b) = 113 compare (toLazyByteString a) (toLazyByteString b) 114 115-- | A series of values that, when encoded, should be separated by 116-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create 117-- either @(Text, Value)@ or 'Series'. You can use Series when 118-- encoding directly to a bytestring builder as in the following 119-- example: 120-- 121-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age) 122data Series = Empty 123 | Value (Encoding' Series) 124 deriving (Typeable) 125 126pair :: Text -> Encoding -> Series 127pair name val = pair' (text name) val 128{-# INLINE pair #-} 129 130pairStr :: String -> Encoding -> Series 131pairStr name val = pair' (string name) val 132{-# INLINE pairStr #-} 133 134pair' :: Encoding' Text -> Encoding -> Series 135pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val 136 137instance Semigroup Series where 138 Empty <> a = a 139 a <> Empty = a 140 Value a <> Value b = Value (a >< comma >< b) 141 142instance Monoid Series where 143 mempty = Empty 144 mappend = (<>) 145 146nullEncoding :: Encoding' a -> Bool 147nullEncoding = BSL.null . toLazyByteString . fromEncoding 148 149emptyArray_ :: Encoding 150emptyArray_ = Encoding EB.emptyArray_ 151 152emptyObject_ :: Encoding 153emptyObject_ = Encoding EB.emptyObject_ 154 155wrapArray :: Encoding' a -> Encoding 156wrapArray e = retagEncoding $ openBracket >< e >< closeBracket 157 158wrapObject :: Encoding' a -> Encoding 159wrapObject e = retagEncoding $ openCurly >< e >< closeCurly 160 161null_ :: Encoding 162null_ = Encoding EB.null_ 163 164bool :: Bool -> Encoding 165bool True = Encoding "true" 166bool False = Encoding "false" 167 168-- | Encode a series of key/value pairs, separated by commas. 169pairs :: Series -> Encoding 170pairs (Value v) = openCurly >< retagEncoding v >< closeCurly 171pairs Empty = emptyObject_ 172{-# INLINE pairs #-} 173 174list :: (a -> Encoding) -> [a] -> Encoding 175list _ [] = emptyArray_ 176list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket 177 where 178 commas = foldr (\v vs -> comma >< to' v >< vs) empty 179{-# INLINE list #-} 180 181-- | Encode as JSON object 182dict 183 :: (k -> Encoding' Text) -- ^ key encoding 184 -> (v -> Encoding) -- ^ value encoding 185 -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold 186 -> m -- ^ container 187 -> Encoding 188dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty 189 where 190 go k v c = Value (encodeKV k v) <> c 191 encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v) 192{-# INLINE dict #-} 193 194-- | Type tag for tuples contents, see 'tuple'. 195data InArray 196 197infixr 6 >*< 198-- | See 'tuple'. 199(>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray 200a >*< b = retagEncoding a >< comma >< retagEncoding b 201{-# INLINE (>*<) #-} 202 203empty :: Encoding' a 204empty = Encoding mempty 205 206econcat :: [Encoding' a] -> Encoding' a 207econcat = foldr (><) empty 208 209infixr 6 >< 210(><) :: Encoding' a -> Encoding' a -> Encoding' a 211Encoding a >< Encoding b = Encoding (a <> b) 212{-# INLINE (><) #-} 213 214-- | Encode as a tuple. 215-- 216-- @ 217-- toEncoding (X a b c) = tuple $ 218-- toEncoding a >*< 219-- toEncoding b >*< 220-- toEncoding c 221tuple :: Encoding' InArray -> Encoding 222tuple b = retagEncoding $ openBracket >< b >< closeBracket 223{-# INLINE tuple #-} 224 225text :: Text -> Encoding' a 226text = Encoding . EB.text 227 228lazyText :: LT.Text -> Encoding' a 229lazyText t = Encoding $ 230 B.char7 '"' <> 231 LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t 232 233string :: String -> Encoding' a 234string = Encoding . EB.string 235 236------------------------------------------------------------------------------- 237-- chars 238------------------------------------------------------------------------------- 239 240comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a 241comma = Encoding $ char7 ',' 242colon = Encoding $ char7 ':' 243openBracket = Encoding $ char7 '[' 244closeBracket = Encoding $ char7 ']' 245openCurly = Encoding $ char7 '{' 246closeCurly = Encoding $ char7 '}' 247 248------------------------------------------------------------------------------- 249-- Decimal numbers 250------------------------------------------------------------------------------- 251 252int8 :: Int8 -> Encoding 253int8 = Encoding . B.int8Dec 254 255int16 :: Int16 -> Encoding 256int16 = Encoding . B.int16Dec 257 258int32 :: Int32 -> Encoding 259int32 = Encoding . B.int32Dec 260 261int64 :: Int64 -> Encoding 262int64 = Encoding . B.int64Dec 263 264int :: Int -> Encoding 265int = Encoding . B.intDec 266 267word8 :: Word8 -> Encoding 268word8 = Encoding . B.word8Dec 269 270word16 :: Word16 -> Encoding 271word16 = Encoding . B.word16Dec 272 273word32 :: Word32 -> Encoding 274word32 = Encoding . B.word32Dec 275 276word64 :: Word64 -> Encoding 277word64 = Encoding . B.word64Dec 278 279word :: Word -> Encoding 280word = Encoding . B.wordDec 281 282integer :: Integer -> Encoding 283integer = Encoding . B.integerDec 284 285float :: Float -> Encoding 286float = realFloatToEncoding $ Encoding . B.floatDec 287 288double :: Double -> Encoding 289double = realFloatToEncoding $ Encoding . B.doubleDec 290 291scientific :: Scientific -> Encoding 292scientific = Encoding . EB.scientific 293 294realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding 295realFloatToEncoding e d 296 | isNaN d || isInfinite d = null_ 297 | otherwise = e d 298{-# INLINE realFloatToEncoding #-} 299 300------------------------------------------------------------------------------- 301-- Decimal numbers as Text 302------------------------------------------------------------------------------- 303 304int8Text :: Int8 -> Encoding' a 305int8Text = Encoding . EB.quote . B.int8Dec 306 307int16Text :: Int16 -> Encoding' a 308int16Text = Encoding . EB.quote . B.int16Dec 309 310int32Text :: Int32 -> Encoding' a 311int32Text = Encoding . EB.quote . B.int32Dec 312 313int64Text :: Int64 -> Encoding' a 314int64Text = Encoding . EB.quote . B.int64Dec 315 316intText :: Int -> Encoding' a 317intText = Encoding . EB.quote . B.intDec 318 319word8Text :: Word8 -> Encoding' a 320word8Text = Encoding . EB.quote . B.word8Dec 321 322word16Text :: Word16 -> Encoding' a 323word16Text = Encoding . EB.quote . B.word16Dec 324 325word32Text :: Word32 -> Encoding' a 326word32Text = Encoding . EB.quote . B.word32Dec 327 328word64Text :: Word64 -> Encoding' a 329word64Text = Encoding . EB.quote . B.word64Dec 330 331wordText :: Word -> Encoding' a 332wordText = Encoding . EB.quote . B.wordDec 333 334integerText :: Integer -> Encoding' a 335integerText = Encoding . EB.quote . B.integerDec 336 337floatText :: Float -> Encoding' a 338floatText = Encoding . EB.quote . B.floatDec 339 340doubleText :: Double -> Encoding' a 341doubleText = Encoding . EB.quote . B.doubleDec 342 343scientificText :: Scientific -> Encoding' a 344scientificText = Encoding . EB.quote . EB.scientific 345 346------------------------------------------------------------------------------- 347-- time 348------------------------------------------------------------------------------- 349 350day :: Day -> Encoding' a 351day = Encoding . EB.quote . EB.day 352 353localTime :: LocalTime -> Encoding' a 354localTime = Encoding . EB.quote . EB.localTime 355 356utcTime :: UTCTime -> Encoding' a 357utcTime = Encoding . EB.quote . EB.utcTime 358 359timeOfDay :: TimeOfDay -> Encoding' a 360timeOfDay = Encoding . EB.quote . EB.timeOfDay 361 362zonedTime :: ZonedTime -> Encoding' a 363zonedTime = Encoding . EB.quote . EB.zonedTime 364 365------------------------------------------------------------------------------- 366-- Value 367------------------------------------------------------------------------------- 368 369value :: Value -> Encoding 370value = Encoding . EB.encodeToBuilder 371