1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3{-# LANGUAGE DeriveGeneric #-} 4{-# LANGUAGE GeneralizedNewtypeDeriving #-} 5{-# LANGUAGE NoImplicitPrelude #-} 6{-# LANGUAGE Rank2Types #-} 7{-# LANGUAGE StandaloneDeriving #-} 8#if __GLASGOW_HASKELL__ >= 800 9-- a) THQ works on cross-compilers and unregisterised GHCs 10-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this) 11-- c) removes one hindrance to have code inferred as SafeHaskell safe 12{-# LANGUAGE TemplateHaskellQuotes #-} 13#else 14{-# LANGUAGE TemplateHaskell #-} 15#endif 16 17-- | 18-- Module: Data.Aeson.Types.Internal 19-- Copyright: (c) 2011-2016 Bryan O'Sullivan 20-- (c) 2011 MailRank, Inc. 21-- License: BSD3 22-- Maintainer: Bryan O'Sullivan <bos@serpentine.com> 23-- Stability: experimental 24-- Portability: portable 25-- 26-- Types for working with JSON data. 27 28module Data.Aeson.Types.Internal 29 ( 30 -- * Core JSON types 31 Value(..) 32 , Array 33 , emptyArray, isEmptyArray 34 , Pair 35 , Object 36 , emptyObject 37 38 -- * Type conversion 39 , Parser 40 , Result(..) 41 , IResult(..) 42 , JSONPathElement(..) 43 , JSONPath 44 , iparse 45 , parse 46 , parseEither 47 , parseMaybe 48 , parseFail 49 , modifyFailure 50 , prependFailure 51 , parserThrowError 52 , parserCatchError 53 , formatError 54 , formatPath 55 , formatRelativePath 56 , (<?>) 57 -- * Constructors and accessors 58 , object 59 60 -- * Generic and TH encoding configuration 61 , Options( 62 fieldLabelModifier 63 , constructorTagModifier 64 , allNullaryToStringTag 65 , omitNothingFields 66 , sumEncoding 67 , unwrapUnaryRecords 68 , tagSingleConstructors 69 , rejectUnknownFields 70 ) 71 72 , SumEncoding(..) 73 , JSONKeyOptions(keyModifier) 74 , defaultOptions 75 , defaultTaggedObject 76 , defaultJSONKeyOptions 77 78 -- * Used for changing CamelCase names into something else. 79 , camelTo 80 , camelTo2 81 82 -- * Other types 83 , DotNetTime(..) 84 ) where 85 86import Prelude.Compat 87 88import Control.Applicative (Alternative(..)) 89import Control.Arrow (first) 90import Control.DeepSeq (NFData(..)) 91import Control.Monad (MonadPlus(..), ap) 92import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum) 93import Data.Data (Data) 94import Data.Foldable (foldl') 95import Data.HashMap.Strict (HashMap) 96import Data.Hashable (Hashable(..)) 97import Data.List (intercalate, sortBy) 98import Data.Ord (comparing) 99import Data.Scientific (Scientific) 100import Data.String (IsString(..)) 101import Data.Text (Text, pack, unpack) 102import Data.Time (UTCTime) 103import Data.Time.Format (FormatTime) 104import Data.Typeable (Typeable) 105import Data.Vector (Vector) 106import GHC.Generics (Generic) 107import qualified Control.Monad as Monad 108import qualified Control.Monad.Fail as Fail 109import qualified Data.HashMap.Strict as H 110import qualified Data.Scientific as S 111import qualified Data.Vector as V 112import qualified Language.Haskell.TH.Syntax as TH 113 114-- | Elements of a JSON path used to describe the location of an 115-- error. 116data JSONPathElement = Key Text 117 -- ^ JSON path element of a key into an object, 118 -- \"object.key\". 119 | Index {-# UNPACK #-} !Int 120 -- ^ JSON path element of an index into an 121 -- array, \"array[index]\". 122 deriving (Eq, Show, Typeable, Ord) 123type JSONPath = [JSONPathElement] 124 125-- | The internal result of running a 'Parser'. 126data IResult a = IError JSONPath String 127 | ISuccess a 128 deriving (Eq, Show, Typeable) 129 130-- | The result of running a 'Parser'. 131data Result a = Error String 132 | Success a 133 deriving (Eq, Show, Typeable) 134 135instance NFData JSONPathElement where 136 rnf (Key t) = rnf t 137 rnf (Index i) = rnf i 138 139instance (NFData a) => NFData (IResult a) where 140 rnf (ISuccess a) = rnf a 141 rnf (IError path err) = rnf path `seq` rnf err 142 143instance (NFData a) => NFData (Result a) where 144 rnf (Success a) = rnf a 145 rnf (Error err) = rnf err 146 147instance Functor IResult where 148 fmap f (ISuccess a) = ISuccess (f a) 149 fmap _ (IError path err) = IError path err 150 {-# INLINE fmap #-} 151 152instance Functor Result where 153 fmap f (Success a) = Success (f a) 154 fmap _ (Error err) = Error err 155 {-# INLINE fmap #-} 156 157instance Monad.Monad IResult where 158 return = pure 159 {-# INLINE return #-} 160 161 ISuccess a >>= k = k a 162 IError path err >>= _ = IError path err 163 {-# INLINE (>>=) #-} 164 165#if !(MIN_VERSION_base(4,13,0)) 166 fail = Fail.fail 167 {-# INLINE fail #-} 168#endif 169 170instance Fail.MonadFail IResult where 171 fail err = IError [] err 172 {-# INLINE fail #-} 173 174instance Monad.Monad Result where 175 return = pure 176 {-# INLINE return #-} 177 178 Success a >>= k = k a 179 Error err >>= _ = Error err 180 {-# INLINE (>>=) #-} 181 182#if !(MIN_VERSION_base(4,13,0)) 183 fail = Fail.fail 184 {-# INLINE fail #-} 185#endif 186 187instance Fail.MonadFail Result where 188 fail err = Error err 189 {-# INLINE fail #-} 190 191instance Applicative IResult where 192 pure = ISuccess 193 {-# INLINE pure #-} 194 (<*>) = ap 195 {-# INLINE (<*>) #-} 196 197instance Applicative Result where 198 pure = Success 199 {-# INLINE pure #-} 200 (<*>) = ap 201 {-# INLINE (<*>) #-} 202 203instance MonadPlus IResult where 204 mzero = fail "mzero" 205 {-# INLINE mzero #-} 206 mplus a@(ISuccess _) _ = a 207 mplus _ b = b 208 {-# INLINE mplus #-} 209 210instance MonadPlus Result where 211 mzero = fail "mzero" 212 {-# INLINE mzero #-} 213 mplus a@(Success _) _ = a 214 mplus _ b = b 215 {-# INLINE mplus #-} 216 217instance Alternative IResult where 218 empty = mzero 219 {-# INLINE empty #-} 220 (<|>) = mplus 221 {-# INLINE (<|>) #-} 222 223instance Alternative Result where 224 empty = mzero 225 {-# INLINE empty #-} 226 (<|>) = mplus 227 {-# INLINE (<|>) #-} 228 229instance Semigroup (IResult a) where 230 (<>) = mplus 231 {-# INLINE (<>) #-} 232 233instance Monoid (IResult a) where 234 mempty = fail "mempty" 235 {-# INLINE mempty #-} 236 mappend = (<>) 237 {-# INLINE mappend #-} 238 239instance Semigroup (Result a) where 240 (<>) = mplus 241 {-# INLINE (<>) #-} 242 243instance Monoid (Result a) where 244 mempty = fail "mempty" 245 {-# INLINE mempty #-} 246 mappend = (<>) 247 {-# INLINE mappend #-} 248 249instance Foldable IResult where 250 foldMap _ (IError _ _) = mempty 251 foldMap f (ISuccess y) = f y 252 {-# INLINE foldMap #-} 253 254 foldr _ z (IError _ _) = z 255 foldr f z (ISuccess y) = f y z 256 {-# INLINE foldr #-} 257 258instance Foldable Result where 259 foldMap _ (Error _) = mempty 260 foldMap f (Success y) = f y 261 {-# INLINE foldMap #-} 262 263 foldr _ z (Error _) = z 264 foldr f z (Success y) = f y z 265 {-# INLINE foldr #-} 266 267instance Traversable IResult where 268 traverse _ (IError path err) = pure (IError path err) 269 traverse f (ISuccess a) = ISuccess <$> f a 270 {-# INLINE traverse #-} 271 272instance Traversable Result where 273 traverse _ (Error err) = pure (Error err) 274 traverse f (Success a) = Success <$> f a 275 {-# INLINE traverse #-} 276 277-- | Failure continuation. 278type Failure f r = JSONPath -> String -> f r 279-- | Success continuation. 280type Success a f r = a -> f r 281 282-- | A JSON parser. N.B. This might not fit your usual understanding of 283-- "parser". Instead you might like to think of 'Parser' as a "parse result", 284-- i.e. a parser to which the input has already been applied. 285newtype Parser a = Parser { 286 runParser :: forall f r. 287 JSONPath 288 -> Failure f r 289 -> Success a f r 290 -> f r 291 } 292 293instance Monad.Monad Parser where 294 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks 295 in runParser m path kf ks' 296 {-# INLINE (>>=) #-} 297 return = pure 298 {-# INLINE return #-} 299 300#if !(MIN_VERSION_base(4,13,0)) 301 fail = Fail.fail 302 {-# INLINE fail #-} 303#endif 304 305instance Fail.MonadFail Parser where 306 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg 307 {-# INLINE fail #-} 308 309instance Functor Parser where 310 fmap f m = Parser $ \path kf ks -> let ks' a = ks (f a) 311 in runParser m path kf ks' 312 {-# INLINE fmap #-} 313 314instance Applicative Parser where 315 pure a = Parser $ \_path _kf ks -> ks a 316 {-# INLINE pure #-} 317 (<*>) = apP 318 {-# INLINE (<*>) #-} 319 320instance Alternative Parser where 321 empty = fail "empty" 322 {-# INLINE empty #-} 323 (<|>) = mplus 324 {-# INLINE (<|>) #-} 325 326instance MonadPlus Parser where 327 mzero = fail "mzero" 328 {-# INLINE mzero #-} 329 mplus a b = Parser $ \path kf ks -> let kf' _ _ = runParser b path kf ks 330 in runParser a path kf' ks 331 {-# INLINE mplus #-} 332 333instance Semigroup (Parser a) where 334 (<>) = mplus 335 {-# INLINE (<>) #-} 336 337instance Monoid (Parser a) where 338 mempty = fail "mempty" 339 {-# INLINE mempty #-} 340 mappend = (<>) 341 {-# INLINE mappend #-} 342 343-- | Raise a parsing failure with some custom message. 344parseFail :: String -> Parser a 345parseFail = fail 346 347apP :: Parser (a -> b) -> Parser a -> Parser b 348apP d e = do 349 b <- d 350 b <$> e 351{-# INLINE apP #-} 352 353-- | A JSON \"object\" (key\/value map). 354type Object = HashMap Text Value 355 356-- | A JSON \"array\" (sequence). 357type Array = Vector Value 358 359-- | A JSON value represented as a Haskell value. 360data Value = Object !Object 361 | Array !Array 362 | String !Text 363 | Number !Scientific 364 | Bool !Bool 365 | Null 366 deriving (Eq, Read, Typeable, Data, Generic) 367 368-- | Since version 1.5.6.0 version object values are printed in lexicographic key order 369-- 370-- >>> toJSON $ H.fromList [("a", True), ("z", False)] 371-- Object (fromList [("a",Bool True),("z",Bool False)]) 372-- 373-- >>> toJSON $ H.fromList [("z", False), ("a", True)] 374-- Object (fromList [("a",Bool True),("z",Bool False)]) 375-- 376instance Show Value where 377 showsPrec _ Null = showString "Null" 378 showsPrec d (Bool b) = showParen (d > 10) 379 $ showString "Bool " . showsPrec 11 b 380 showsPrec d (Number s) = showParen (d > 10) 381 $ showString "Number " . showsPrec 11 s 382 showsPrec d (String s) = showParen (d > 10) 383 $ showString "String " . showsPrec 11 s 384 showsPrec d (Array xs) = showParen (d > 10) 385 $ showString "Array " . showsPrec 11 xs 386 showsPrec d (Object xs) = showParen (d > 10) 387 $ showString "Object (fromList " 388 . showsPrec 11 (sortBy (comparing fst) (H.toList xs)) 389 . showChar ')' 390 391-- | 392-- 393-- The ordering is total, consistent with 'Eq' instance. 394-- However, nothing else about the ordering is specified, 395-- and it may change from environment to environment and version to version 396-- of either this package or its dependencies ('hashable' and 'unordered-containers'). 397-- 398-- @since 1.5.2.0 399deriving instance Ord Value 400-- standalone deriving to attach since annotation. 401 402-- | A newtype wrapper for 'UTCTime' that uses the same non-standard 403-- serialization format as Microsoft .NET, whose 404-- <https://msdn.microsoft.com/en-us/library/system.datetime(v=vs.110).aspx System.DateTime> 405-- type is by default serialized to JSON as in the following example: 406-- 407-- > /Date(1302547608878)/ 408-- 409-- The number represents milliseconds since the Unix epoch. 410newtype DotNetTime = DotNetTime { 411 fromDotNetTime :: UTCTime 412 -- ^ Acquire the underlying value. 413 } deriving (Eq, Ord, Read, Show, Typeable, FormatTime) 414 415instance NFData Value where 416 rnf (Object o) = rnf o 417 rnf (Array a) = foldl' (\x y -> rnf y `seq` x) () a 418 rnf (String s) = rnf s 419 rnf (Number n) = rnf n 420 rnf (Bool b) = rnf b 421 rnf Null = () 422 423instance IsString Value where 424 fromString = String . pack 425 {-# INLINE fromString #-} 426 427hashValue :: Int -> Value -> Int 428hashValue s (Object o) = s `hashWithSalt` (0::Int) `hashWithSalt` o 429hashValue s (Array a) = foldl' hashWithSalt 430 (s `hashWithSalt` (1::Int)) a 431hashValue s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str 432hashValue s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n 433hashValue s (Bool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b 434hashValue s Null = s `hashWithSalt` (5::Int) 435 436instance Hashable Value where 437 hashWithSalt = hashValue 438 439-- @since 0.11.0.0 440instance TH.Lift Value where 441 lift Null = [| Null |] 442 lift (Bool b) = [| Bool b |] 443 lift (Number n) = [| Number (S.scientific c e) |] 444 where 445 c = S.coefficient n 446 e = S.base10Exponent n 447 lift (String t) = [| String (pack s) |] 448 where s = unpack t 449 lift (Array a) = [| Array (V.fromList a') |] 450 where a' = V.toList a 451 lift (Object o) = [| Object (H.fromList . map (first pack) $ o') |] 452 where o' = map (first unpack) . H.toList $ o 453#if MIN_VERSION_template_haskell(2,17,0) 454 liftTyped = TH.unsafeCodeCoerce . TH.lift 455#elif MIN_VERSION_template_haskell(2,16,0) 456 liftTyped = TH.unsafeTExpCoerce . TH.lift 457#endif 458 459-- | The empty array. 460emptyArray :: Value 461emptyArray = Array V.empty 462 463-- | Determines if the 'Value' is an empty 'Array'. 464-- Note that: @isEmptyArray 'emptyArray'@. 465isEmptyArray :: Value -> Bool 466isEmptyArray (Array arr) = V.null arr 467isEmptyArray _ = False 468 469-- | The empty object. 470emptyObject :: Value 471emptyObject = Object H.empty 472 473-- | Run a 'Parser'. 474parse :: (a -> Parser b) -> a -> Result b 475parse m v = runParser (m v) [] (const Error) Success 476{-# INLINE parse #-} 477 478-- | Run a 'Parser'. 479iparse :: (a -> Parser b) -> a -> IResult b 480iparse m v = runParser (m v) [] IError ISuccess 481{-# INLINE iparse #-} 482 483-- | Run a 'Parser' with a 'Maybe' result type. 484parseMaybe :: (a -> Parser b) -> a -> Maybe b 485parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just 486{-# INLINE parseMaybe #-} 487 488-- | Run a 'Parser' with an 'Either' result type. If the parse fails, 489-- the 'Left' payload will contain an error message. 490parseEither :: (a -> Parser b) -> a -> Either String b 491parseEither m v = runParser (m v) [] onError Right 492 where onError path msg = Left (formatError path msg) 493{-# INLINE parseEither #-} 494 495-- | Annotate an error message with a 496-- <http://goessner.net/articles/JsonPath/ JSONPath> error location. 497formatError :: JSONPath -> String -> String 498formatError path msg = "Error in " ++ formatPath path ++ ": " ++ msg 499 500-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String', 501-- representing the root object as @$@. 502formatPath :: JSONPath -> String 503formatPath path = "$" ++ formatRelativePath path 504 505-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String' 506-- which represents the path relative to some root object. 507formatRelativePath :: JSONPath -> String 508formatRelativePath path = format "" path 509 where 510 format :: String -> JSONPath -> String 511 format pfx [] = pfx 512 format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts 513 format pfx (Key key:parts) = format (pfx ++ formatKey key) parts 514 515 formatKey :: Text -> String 516 formatKey key 517 | isIdentifierKey strKey = "." ++ strKey 518 | otherwise = "['" ++ escapeKey strKey ++ "']" 519 where strKey = unpack key 520 521 isIdentifierKey :: String -> Bool 522 isIdentifierKey [] = False 523 isIdentifierKey (x:xs) = isAlpha x && all isAlphaNum xs 524 525 escapeKey :: String -> String 526 escapeKey = concatMap escapeChar 527 528 escapeChar :: Char -> String 529 escapeChar '\'' = "\\'" 530 escapeChar '\\' = "\\\\" 531 escapeChar c = [c] 532 533-- | A key\/value pair for an 'Object'. 534type Pair = (Text, Value) 535 536-- | Create a 'Value' from a list of name\/value 'Pair's. If duplicate 537-- keys arise, earlier keys and their associated values win. 538object :: [Pair] -> Value 539object = Object . H.fromList 540{-# INLINE object #-} 541 542-- | Add JSON Path context to a parser 543-- 544-- When parsing a complex structure, it helps to annotate (sub)parsers 545-- with context, so that if an error occurs, you can find its location. 546-- 547-- > withObject "Person" $ \o -> 548-- > Person 549-- > <$> o .: "name" <?> Key "name" 550-- > <*> o .: "age" <?> Key "age" 551-- 552-- (Standard methods like '(.:)' already do this.) 553-- 554-- With such annotations, if an error occurs, you will get a JSON Path 555-- location of that error. 556-- 557-- Since 0.10 558(<?>) :: Parser a -> JSONPathElement -> Parser a 559p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks 560 561-- | If the inner @Parser@ failed, modify the failure message using the 562-- provided function. This allows you to create more descriptive error messages. 563-- For example: 564-- 565-- > parseJSON (Object o) = modifyFailure 566-- > ("Parsing of the Foo value failed: " ++) 567-- > (Foo <$> o .: "someField") 568-- 569-- Since 0.6.2.0 570modifyFailure :: (String -> String) -> Parser a -> Parser a 571modifyFailure f (Parser p) = Parser $ \path kf ks -> 572 p path (\p' m -> kf p' (f m)) ks 573 574-- | If the inner 'Parser' failed, prepend the given string to the failure 575-- message. 576-- 577-- @ 578-- 'prependFailure' s = 'modifyFailure' (s '++') 579-- @ 580prependFailure :: String -> Parser a -> Parser a 581prependFailure = modifyFailure . (++) 582 583-- | Throw a parser error with an additional path. 584-- 585-- @since 1.2.1.0 586parserThrowError :: JSONPath -> String -> Parser a 587parserThrowError path' msg = Parser $ \path kf _ks -> 588 kf (reverse path ++ path') msg 589 590-- | A handler function to handle previous errors and return to normal execution. 591-- 592-- @since 1.2.1.0 593parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a 594parserCatchError (Parser p) handler = Parser $ \path kf ks -> 595 p path (\e msg -> runParser (handler e msg) path kf ks) ks 596 597-------------------------------------------------------------------------------- 598-- Generic and TH encoding configuration 599-------------------------------------------------------------------------------- 600 601-- | Options that specify how to encode\/decode your datatype to\/from JSON. 602-- 603-- Options can be set using record syntax on 'defaultOptions' with the fields 604-- below. 605data Options = Options 606 { fieldLabelModifier :: String -> String 607 -- ^ Function applied to field labels. 608 -- Handy for removing common record prefixes for example. 609 , constructorTagModifier :: String -> String 610 -- ^ Function applied to constructor tags which could be handy 611 -- for lower-casing them for example. 612 , allNullaryToStringTag :: Bool 613 -- ^ If 'True' the constructors of a datatype, with /all/ 614 -- nullary constructors, will be encoded to just a string with 615 -- the constructor tag. If 'False' the encoding will always 616 -- follow the `sumEncoding`. 617 , omitNothingFields :: Bool 618 -- ^ If 'True', record fields with a 'Nothing' value will be 619 -- omitted from the resulting object. If 'False', the resulting 620 -- object will include those fields mapping to @null@. 621 -- 622 -- Note that this /does not/ affect parsing: 'Maybe' fields are 623 -- optional regardless of the value of 'omitNothingFields', subject 624 -- to the note below. 625 -- 626 -- === Note 627 -- 628 -- Setting 'omitNothingFields' to 'True' only affects fields which are of 629 -- type 'Maybe' /uniformly/ in the 'ToJSON' instance. 630 -- In particular, if the type of a field is declared as a type variable, it 631 -- will not be omitted from the JSON object, unless the field is 632 -- specialized upfront in the instance. 633 -- 634 -- The same holds for 'Maybe' fields being optional in the 'FromJSON' instance. 635 -- 636 -- ==== __Example__ 637 -- 638 -- The generic instance for the following type @Fruit@ depends on whether 639 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@. 640 -- 641 -- @ 642 -- data Fruit a = Fruit 643 -- { apples :: a -- A field whose type is a type variable. 644 -- , oranges :: 'Maybe' Int 645 -- } deriving 'Generic' 646 -- 647 -- -- apples required, oranges optional 648 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)). 649 -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) 650 -- 651 -- -- apples optional, oranges optional 652 -- -- In this instance, the field apples is uniformly of type ('Maybe' a). 653 -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a)) 654 -- 655 -- options :: 'Options' 656 -- options = 'defaultOptions' { 'omitNothingFields' = 'True' } 657 -- 658 -- -- apples always present in the output, oranges is omitted if 'Nothing' 659 -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit a) where 660 -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options 661 -- 662 -- -- both apples and oranges are omitted if 'Nothing' 663 -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit ('Maybe' a)) where 664 -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options 665 -- @ 666 , sumEncoding :: SumEncoding 667 -- ^ Specifies how to encode constructors of a sum datatype. 668 , unwrapUnaryRecords :: Bool 669 -- ^ Hide the field name when a record constructor has only one 670 -- field, like a newtype. 671 , tagSingleConstructors :: Bool 672 -- ^ Encode types with a single constructor as sums, 673 -- so that `allNullaryToStringTag` and `sumEncoding` apply. 674 , rejectUnknownFields :: Bool 675 -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in 676 -- the parsed object map, but does not appear in the target object, parsing 677 -- will fail, with an error message indicating which fields were unknown. 678 } 679 680instance Show Options where 681 show (Options f c a o s u t r) = 682 "Options {" 683 ++ intercalate ", " 684 [ "fieldLabelModifier =~ " ++ show (f "exampleField") 685 , "constructorTagModifier =~ " ++ show (c "ExampleConstructor") 686 , "allNullaryToStringTag = " ++ show a 687 , "omitNothingFields = " ++ show o 688 , "sumEncoding = " ++ show s 689 , "unwrapUnaryRecords = " ++ show u 690 , "tagSingleConstructors = " ++ show t 691 , "rejectUnknownFields = " ++ show r 692 ] 693 ++ "}" 694 695-- | Specifies how to encode constructors of a sum datatype. 696data SumEncoding = 697 TaggedObject { tagFieldName :: String 698 , contentsFieldName :: String 699 } 700 -- ^ A constructor will be encoded to an object with a field 701 -- 'tagFieldName' which specifies the constructor tag (modified by 702 -- the 'constructorTagModifier'). If the constructor is a record 703 -- the encoded record fields will be unpacked into this object. So 704 -- make sure that your record doesn't have a field with the same 705 -- label as the 'tagFieldName'. Otherwise the tag gets overwritten 706 -- by the encoded value of that field! If the constructor is not a 707 -- record the encoded constructor contents will be stored under 708 -- the 'contentsFieldName' field. 709 | UntaggedValue 710 -- ^ Constructor names won't be encoded. Instead only the contents of the 711 -- constructor will be encoded as if the type had a single constructor. JSON 712 -- encodings have to be disjoint for decoding to work properly. 713 -- 714 -- When decoding, constructors are tried in the order of definition. If some 715 -- encodings overlap, the first one defined will succeed. 716 -- 717 -- /Note:/ Nullary constructors are encoded as strings (using 718 -- 'constructorTagModifier'). Having a nullary constructor alongside a 719 -- single field constructor that encodes to a string leads to ambiguity. 720 -- 721 -- /Note:/ Only the last error is kept when decoding, so in the case of 722 -- malformed JSON, only an error for the last constructor will be reported. 723 | ObjectWithSingleField 724 -- ^ A constructor will be encoded to an object with a single 725 -- field named after the constructor tag (modified by the 726 -- 'constructorTagModifier') which maps to the encoded contents of 727 -- the constructor. 728 | TwoElemArray 729 -- ^ A constructor will be encoded to a 2-element array where the 730 -- first element is the tag of the constructor (modified by the 731 -- 'constructorTagModifier') and the second element the encoded 732 -- contents of the constructor. 733 deriving (Eq, Show) 734 735-- | Options for encoding keys with 'Data.Aeson.Types.genericFromJSONKey' and 736-- 'Data.Aeson.Types.genericToJSONKey'. 737data JSONKeyOptions = JSONKeyOptions 738 { keyModifier :: String -> String 739 -- ^ Function applied to keys. Its result is what goes into the encoded 740 -- 'Value'. 741 -- 742 -- === __Example__ 743 -- 744 -- The following instances encode the constructor @Bar@ to lower-case keys 745 -- @\"bar\"@. 746 -- 747 -- @ 748 -- data Foo = Bar 749 -- deriving 'Generic' 750 -- 751 -- opts :: 'JSONKeyOptions' 752 -- opts = 'defaultJSONKeyOptions' { 'keyModifier' = 'toLower' } 753 -- 754 -- instance 'ToJSONKey' Foo where 755 -- 'toJSONKey' = 'genericToJSONKey' opts 756 -- 757 -- instance 'FromJSONKey' Foo where 758 -- 'fromJSONKey' = 'genericFromJSONKey' opts 759 -- @ 760 } 761 762-- | Default encoding 'Options': 763-- 764-- @ 765-- 'Options' 766-- { 'fieldLabelModifier' = id 767-- , 'constructorTagModifier' = id 768-- , 'allNullaryToStringTag' = True 769-- , 'omitNothingFields' = False 770-- , 'sumEncoding' = 'defaultTaggedObject' 771-- , 'unwrapUnaryRecords' = False 772-- , 'tagSingleConstructors' = False 773-- , 'rejectUnknownFields' = False 774-- } 775-- @ 776defaultOptions :: Options 777defaultOptions = Options 778 { fieldLabelModifier = id 779 , constructorTagModifier = id 780 , allNullaryToStringTag = True 781 , omitNothingFields = False 782 , sumEncoding = defaultTaggedObject 783 , unwrapUnaryRecords = False 784 , tagSingleConstructors = False 785 , rejectUnknownFields = False 786 } 787 788-- | Default 'TaggedObject' 'SumEncoding' options: 789-- 790-- @ 791-- defaultTaggedObject = 'TaggedObject' 792-- { 'tagFieldName' = \"tag\" 793-- , 'contentsFieldName' = \"contents\" 794-- } 795-- @ 796defaultTaggedObject :: SumEncoding 797defaultTaggedObject = TaggedObject 798 { tagFieldName = "tag" 799 , contentsFieldName = "contents" 800 } 801 802-- | Default 'JSONKeyOptions': 803-- 804-- @ 805-- defaultJSONKeyOptions = 'JSONKeyOptions' 806-- { 'keyModifier' = 'id' 807-- } 808-- @ 809defaultJSONKeyOptions :: JSONKeyOptions 810defaultJSONKeyOptions = JSONKeyOptions id 811 812-- | Converts from CamelCase to another lower case, interspersing 813-- the character between all capital letters and their previous 814-- entries, except those capital letters that appear together, 815-- like 'API'. 816-- 817-- For use by Aeson template haskell calls. 818-- 819-- > camelTo '_' 'CamelCaseAPI' == "camel_case_api" 820camelTo :: Char -> String -> String 821{-# DEPRECATED camelTo "Use camelTo2 for better results" #-} 822camelTo c = lastWasCap True 823 where 824 lastWasCap :: Bool -- ^ Previous was a capital letter 825 -> String -- ^ The remaining string 826 -> String 827 lastWasCap _ [] = [] 828 lastWasCap prev (x : xs) = if isUpper x 829 then if prev 830 then toLower x : lastWasCap True xs 831 else c : toLower x : lastWasCap True xs 832 else x : lastWasCap False xs 833 834-- | Better version of 'camelTo'. Example where it works better: 835-- 836-- > camelTo '_' 'CamelAPICase' == "camel_apicase" 837-- > camelTo2 '_' 'CamelAPICase' == "camel_api_case" 838camelTo2 :: Char -> String -> String 839camelTo2 c = map toLower . go2 . go1 840 where go1 "" = "" 841 go1 (x:u:l:xs) | isUpper u && isLower l = x : c : u : l : go1 xs 842 go1 (x:xs) = x : go1 xs 843 go2 "" = "" 844 go2 (l:u:xs) | isLower l && isUpper u = l : c : u : go2 xs 845 go2 (x:xs) = x : go2 xs 846