Merge pull request #7 from juspay/kana-json-options

Add options to json encoder/decoder

jrec.cabal

@@ -17,6 +17,13 @@ extra-source-files:
   CHANGELOG.md
   README.md
 
+flag with-aeson
+  description: Enable Aeson instances
+  -- don't let the solver fiddle with the flag
+  manual: True
+  -- with instances by default
+  default: True
+
 -- A common stanza to share with tests, so that ghcid (bin/test) will reload
 -- instantly when the library sources change (without us having to restart it).
 common library-common 
@@ -72,6 +79,8 @@ library
   other-modules:
     JRec.Tuple
     JRec.Field
+  if flag(with-aeson)
+    cpp-options: -DWITH_AESON
 
 test-suite jrec-test
   import: library-common

src/JRec/Internal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -87,6 +88,12 @@ data Rec (lts :: [*]) = MkRec
   { _unRec :: SmallArray# Any -- Note that the values are physically in reverse order
   }
 
+data JSONOptions = JSONOptions
+  {fieldTransform :: String -> String}
+
+defaultJSONOptions :: JSONOptions
+defaultJSONOptions = JSONOptions {fieldTransform = id}
+
 type role Rec representational
 
 instance
@@ -102,16 +109,18 @@ instance RecEq lts lts => Eq (Rec lts) where
   (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)
   {-# INLINE (==) #-}
 
+#ifdef WITH_AESON
 instance
   ( RecApply lts lts ToJSON
   ) =>
   ToJSON (Rec lts)
   where
-  toJSON = recToValue
-  toEncoding = recToEncoding
+  toJSON = recToValue defaultJSONOptions
+  toEncoding = recToEncoding defaultJSONOptions
 
 instance (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => FromJSON (Rec lts) where
-  parseJSON = recJsonParser
+  parseJSON = recJsonParser defaultJSONOptions
+#endif
 
 instance RecNfData lts lts => NFData (Rec lts) where
   rnf = recNfData (Proxy :: Proxy lts)
@@ -459,8 +468,6 @@ insert (l := v) rts =
                         (# s''''#, a# #) -> (# s''''#, MkRec a# #)
 {-# INLINE insert #-}
 
-
-
 -- | Alias for 'combine'
 (++:) ::
   forall lhs rhs res.
@@ -538,16 +545,21 @@ reflectRecFold _ f r =
 showRec :: forall lts. (RecApply lts lts Show) => Rec lts -> [(String, String)]
 showRec = reflectRec @Show Proxy (\k v -> (k, show v))
 
-recToValue :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Value
-recToValue r = object $ reflectRec @ToJSON Proxy (\k v -> (T.pack k, toJSON v)) r
+recToValue :: forall lts. (RecApply lts lts ToJSON) => JSONOptions -> Rec lts -> Value
+recToValue options r =
+  object $ reflectRec @ToJSON Proxy (\k v -> (T.pack (fieldTransform options k), toJSON v)) r
 
-recToEncoding :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Encoding
-recToEncoding r = pairs $ mconcat $ reflectRec @ToJSON Proxy (\k v -> (T.pack k .= v)) r
+recToEncoding :: forall lts. (RecApply lts lts ToJSON) => JSONOptions -> Rec lts -> Encoding
+recToEncoding options r =
+  pairs $ mconcat $ reflectRec @ToJSON Proxy (\k v -> (T.pack (fieldTransform options k) .= v)) r
 
-recJsonParser :: forall lts s. (RecSize lts ~ s, KnownNat s, RecJsonParse lts) => Value -> Parser (Rec lts)
-recJsonParser =
+recJsonParser ::
+  forall lts s.
+  (RecSize lts ~ s, KnownNat s, RecJsonParse lts) =>
+  (JSONOptions -> Value -> Parser (Rec lts))
+recJsonParser options =
   withObject "Record" $ \o ->
-    recJsonParse initSize o
+    recJsonParse options initSize o
   where
     initSize = fromIntegral $ natVal' (proxy# :: Proxy# s)
 
@@ -607,10 +619,10 @@ type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where
 
 -- | Machinery to implement parseJSON
 class RecJsonParse (lts :: [*]) where
-  recJsonParse :: Int -> Object -> Parser (Rec lts)
+  recJsonParse :: JSONOptions -> Int -> Object -> Parser (Rec lts)
 
 instance RecJsonParse '[] where
-  recJsonParse initSize _ = pure (unsafeRNil initSize)
+  recJsonParse _ initSize _ = pure (unsafeRNil initSize)
 
 instance
   ( KnownSymbol l,
@@ -622,12 +634,11 @@ instance
   ) =>
   RecJsonParse (l := t ': lts)
   where
-  recJsonParse initSize obj =
-    do
+  recJsonParse options initSize obj = do
     let lbl :: FldProxy l
         lbl = FldProxy
-      rest <- recJsonParse initSize obj
-      (v :: t) <- obj .: T.pack (symbolVal lbl)
+    rest <- recJsonParse options initSize obj
+    (v :: t) <- obj .: T.pack (fieldTransform options (symbolVal lbl))
     pure $ unsafeRCons (lbl := v) rest
 
 -- | Machinery for NFData