@@ -1,4 +1,5 @@
11{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE ConstraintKinds #-}
34{-# LANGUAGE DataKinds #-}
45{-# LANGUAGE ExistentialQuantification #-}
@@ -87,6 +88,12 @@ data Rec (lts :: [*]) = MkRec
8788 { _unRec :: SmallArray# Any -- Note that the values are physically in reverse order
8889 }
8990
91+data JSONOptions = JSONOptions
92+ {fieldTransform :: String -> String}
93+
94+defaultJSONOptions :: JSONOptions
95+defaultJSONOptions = JSONOptions {fieldTransform = id}
96+
9097type role Rec representational
9198
9299instance
@@ -102,16 +109,18 @@ instance RecEq lts lts => Eq (Rec lts) where
102109 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)
103110 {-# INLINE (==) #-}
104111
112+#ifdef WITH_AESON
105113instance
106114 ( RecApply lts lts ToJSON
107115 ) =>
108116 ToJSON (Rec lts)
109117 where
110− toJSON = recToValue
111− toEncoding = recToEncoding
118+ toJSON = recToValue defaultJSONOptions
119+ toEncoding = recToEncoding defaultJSONOptions
112120
113121instance (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => FromJSON (Rec lts) where
114− parseJSON = recJsonParser
122+ parseJSON = recJsonParser defaultJSONOptions
123+#endif
115124
116125instance RecNfData lts lts => NFData (Rec lts) where
117126 rnf = recNfData (Proxy :: Proxy lts)
@@ -222,7 +231,7 @@ type family KeyDoesNotExist (l :: Symbol) (lts :: [*]) :: Constraint where
222231 )
223232 KeyDoesNotExist q (l := t ': lts) = KeyDoesNotExist q lts
224233
225−type family Reverse (xs :: [*]) where
234+type family Reverse (xs :: [*]) where
226235 Reverse '[] = '[]
227236 Reverse (x ': xs) = RecAppend (Reverse xs) '[x]
228237
@@ -430,7 +439,7 @@ union lts rts =
430439{-# INLINE union #-}
431440
432441-- | Insert a field
433−--
442+--
434443-- Insert at beginning, unless the field already exists, in which case set it
435444-- directly.
436445insert ::
@@ -459,8 +468,6 @@ insert (l := v) rts =
459468 (# s''''#, a# #) -> (# s''''#, MkRec a# #)
460469{-# INLINE insert #-}
461470
462−
463−
464471-- | Alias for 'combine'
465472(++:) ::
466473 forall lhs rhs res.
@@ -538,16 +545,21 @@ reflectRecFold _ f r =
538545showRec :: forall lts. (RecApply lts lts Show) => Rec lts -> [(String, String)]
539546showRec = reflectRec @Show Proxy (\k v -> (k, show v))
540547
541−recToValue :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Value
542−recToValue r = object $ reflectRec @ToJSON Proxy (\k v -> (T.pack k, toJSON v)) r
548+recToValue :: forall lts. (RecApply lts lts ToJSON) => JSONOptions -> Rec lts -> Value
549+recToValue options r =
550+ object $ reflectRec @ToJSON Proxy (\k v -> (T.pack (fieldTransform options k), toJSON v)) r
543551
544−recToEncoding :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Encoding
545−recToEncoding r = pairs $ mconcat $ reflectRec @ToJSON Proxy (\k v -> (T.pack k .= v)) r
552+recToEncoding :: forall lts. (RecApply lts lts ToJSON) => JSONOptions -> Rec lts -> Encoding
553+recToEncoding options r =
554+ pairs $ mconcat $ reflectRec @ToJSON Proxy (\k v -> (T.pack (fieldTransform options k) .= v)) r
546555
547−recJsonParser :: forall lts s. (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => Value -> Parser (Rec lts)
548−recJsonParser =
556+recJsonParser ::
557+ forall lts s.
558+ (RecSize lts ~ s, KnownNat s, RecJsonParse lts) =>
559+ (JSONOptions -> Value -> Parser (Rec lts))
560+recJsonParser options =
549561 withObject "Record" $ \o ->
550− recJsonParse initSize o
562+ recJsonParse options initSize o
551563 where
552564 initSize = fromIntegral $ natVal' (proxy# :: Proxy# s)
553565
@@ -607,10 +619,10 @@ type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where
607619
608620-- | Machinery to implement parseJSON
609621class RecJsonParse (lts :: [*]) where
610− recJsonParse :: Int -> Object -> Parser (Rec lts)
622+ recJsonParse :: JSONOptions -> Int -> Object -> Parser (Rec lts)
611623
612624instance RecJsonParse '[] where
613− recJsonParse initSize _ = pure (unsafeRNil initSize)
625+ recJsonParse _ initSize _ = pure (unsafeRNil initSize)
614626
615627instance
616628 ( KnownSymbol l,
@@ -622,13 +634,12 @@ instance
622634 ) =>
623635 RecJsonParse (l := t ': lts)
624636 where
625− recJsonParse initSize obj =
626− do
627− let lbl :: FldProxy l
628− lbl = FldProxy
629− rest <- recJsonParse initSize obj
630− (v :: t) <- obj .: T.pack (symbolVal lbl)
631− pure $ unsafeRCons (lbl := v) rest
637+ recJsonParse options initSize obj = do
638+ let lbl :: FldProxy l
639+ lbl = FldProxy
640+ rest <- recJsonParse options initSize obj
641+ (v :: t) <- obj .: T.pack (fieldTransform options (symbolVal lbl))
642+ pure $ unsafeRCons (lbl := v) rest
632643
633644-- | Machinery for NFData
634645class RecNfData (lts :: [*]) (rts :: [*]) where
@@ -744,7 +755,7 @@ class NoConstraint x
744755instance NoConstraint x
745756
746757-- | Convert a record into a list of fields.
747−--
758+--
748759-- | Not present in original superrecord
749760getFields :: RecApply fields fields NoConstraint => Rec fields -> [Any]
750761getFields =