@@ -32,7 +32,6 @@ import qualified Control.Monad.State as S
3232import Data.Aeson
3333import Data.Aeson.Types (Parser)
3434import Data.Constraint
35−import Data.List (intercalate)
3635import Data.Maybe (catMaybes)
3736import Data.Proxy
3837import qualified Data.Text as T
@@ -43,17 +42,11 @@ import GHC.OverloadedLabels
4342import GHC.Prim
4443import GHC.ST (ST (..), runST)
4544import GHC.TypeLits
45+import Generic.Data (gshowsPrec)
46+import Generic.Data.Internal.Show (GShow)
4647import qualified Optics.Lens as OL
4748import Unsafe.Coerce
4849import Prelude
49−#if MIN_VERSION_aeson(2,0,0)
50−import Data.Aeson.Key (fromText, fromString)
51−#else
52−fromText :: a -> a
53−fromText = id
54−fromString :: String -> T.Text
55−fromString = T.pack
56−#endif
5750
5851-- | Field named @l@ labels value of type @t@ adapted from the awesome /labels/ package.
5952-- Example: @(#name := \"Chris\") :: (\"name\" := String)@
@@ -109,12 +102,13 @@ defaultJSONOptions = JSONOptions {fieldTransform = id}
109102type role Rec representational
110103
111104instance
112− ( RecApply lts lts Show
105+ ( RecApply lts lts Show,
106+ GShow Proxy (Rep (Rec lts)),
107+ Generic (Rec lts)
113108 ) =>
114109 Show (Rec lts)
115110 where
116− show rec = "{" ++ formatted ++ "}"
117− where formatted = intercalate ", " $ map (\(k, v) -> k ++ " = " ++ v) $ showRec rec
111+ show = (\x -> if null x then "{}" else x) . unwords . drop 1 . words . flip (gshowsPrec 0) ""
118112
119113instance RecEq lts lts => Eq (Rec lts) where
120114 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)
@@ -409,20 +403,26 @@ type family RecDeepTy (ps :: r) (lts :: [*]) :: * where
409403-- NOTE: changed from original superrecord to not require a 'Sort'
410404combine ::
411405 forall lhs rhs res.
412− res ~ RecAppend lhs rhs =>
406+ ( KnownNat (RecSize lhs),
407+ KnownNat (RecSize rhs),
408+ KnownNat (RecSize lhs + RecSize rhs),
409+ res ~ RecAppend lhs rhs,
410+ RecCopy lhs lhs res,
411+ RecCopy rhs rhs res
412+ ) =>
413413 Rec lhs ->
414414 Rec rhs ->
415415 Rec res
416−combine (MkRec arr0#) (MkRec arr1#) =
417− let !size0# = sizeofSmallArray# arr0#
418− !size1# = sizeofSmallArray# arr1#
416+combine lts rts =
417+ let !(I# size#) =
418+ fromIntegral $ natVal' (proxy# :: Proxy# (RecSize lhs + RecSize rhs))
419419 in runST' $
420420 ST $ \s# ->
421− case newSmallArray# (size0# +# size1#) (error "No value") s# of
421+ case newSmallArray# size# (error "No value") s# of
422422 (# s'#, arr# #) ->
423− case copySmallArray# arr1# 0# arr# 0# size1# s'# of
423+ case recCopyInto (Proxy :: Proxy lhs) lts (Proxy :: Proxy res) arr# s'# of
424424 s''# ->
425− case copySmallArray# arr0# 0# arr# size1# size0# s''# of
425+ case recCopyInto (Proxy :: Proxy rhs) rts (Proxy :: Proxy res) arr# s''# of
426426 s'''# ->
427427 case unsafeFreezeSmallArray# arr# s'''# of
428428 (# s''''#, a# #) -> (# s''''#, MkRec a# #)
@@ -492,7 +492,13 @@ insert (l := v) rts =
492492-- | Alias for 'combine'
493493(++:) ::
494494 forall lhs rhs res.
495− res ~ RecAppend lhs rhs =>
495+ ( KnownNat (RecSize lhs),
496+ KnownNat (RecSize rhs),
497+ KnownNat (RecSize lhs + RecSize rhs),
498+ res ~ RecAppend lhs rhs,
499+ RecCopy lhs lhs res,
500+ RecCopy rhs rhs res
501+ ) =>
496502 Rec lhs ->
497503 Rec rhs ->
498504 Rec res
@@ -566,16 +572,16 @@ class ToJSON a => EncodeField a where
566572
567573instance ToJSON a => EncodeField a where
568574 encodeField = pure . toJSON
569− encodeKV k v = fromText k .= v
575+ encodeKV = (.=)
570576
571577instance {-# OVERLAPS #-} ToJSON a => EncodeField (Maybe a) where
572578 encodeField = fmap toJSON
573579 encodeKV _ Nothing = mempty
574− encodeKV k v = fromText k .= v
580+ encodeKV k v = k .= v
575581
576582recToValue :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Value
577583recToValue options r =
578− object $ catMaybes $ reflectRec @EncodeField Proxy (\k v -> (fromString (fieldTransform options k),) <$> encodeField v) r
584+ object $ catMaybes $ reflectRec @EncodeField Proxy (\k v -> (T.pack (fieldTransform options k),) <$> encodeField v) r
579585
580586recToEncoding :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Encoding
581587recToEncoding options r =
@@ -680,10 +686,10 @@ class FromJSON a => ParseField a where
680686 parseField :: Object -> T.Text -> Parser a
681687
682688instance FromJSON a => ParseField a where
683− parseField o k = o .: fromText k
689+ parseField = (.:)
684690
685691instance {-# OVERLAPS #-} FromJSON a => ParseField (Maybe a) where
686− parseField o k = o .:? fromText k
692+ parseField = (.:?)
687693
688694instance
689695 ( KnownSymbol l,