by-other-names 1.2.1.0 → 1.2.2.0

raw patch · 5 files changed

+205/−51 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−1
• by-other-names.cabal +1/−1
• lib/ByOtherNames/Aeson.hs +181/−48
• lib/ByOtherNames/Constraint.hs +9/−1
• tests/tests.hs +1/−0

@@ -1,4 +1,16 @@-+1.2.2.0+=======++- GeneralJSONEnum : like JSONEnum, but lets you define FromJSON/ToJSON instances+  for a newtype that use the generic representation of the wrapped type,+  *without* requiring FromJSON/ToJSON instances from the wrapped type. So it's+  different from GeneralizedNewtypeDeriving: only the generic rep of the wrapped+  type is used!++  JSONEnum instances implemented in terms of GeneralJSONEnum.++- GeneralJSONRecord and GeneralJSONSum.+ 1.2.1.0 ======= 

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                by-other-names-version:             1.2.1.0+version:             1.2.2.0 synopsis:            Give aliases to record fields.  description:         Give aliases to record fields.

@@ -1,11 +1,15 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneKindSignatures #-}@@ -61,7 +65,7 @@ --       $ aliasListEnd -- :} ----- Some limitations:+-- Some observations: -- -- - Fields in branches of sum types can't have selectors. When there is more than one field in a branch, they are parsed as a JSON Array. --@@ -95,7 +99,10 @@     JSONRecord (..),     JSONSum (..),     JSONEnum (..),-+    -- ** Advanced JSON helpers+    GeneralJSONRecord (..),+    GeneralJSONSum (..),+    GeneralJSONEnum (..),     -- * Re-exports from ByOtherNames     Aliased (aliases),     aliasListBegin,@@ -119,6 +126,7 @@ import Data.Void import GHC.Generics import GHC.TypeLits+import ByOtherNames.Constraint  -- | Aliases for JSON serialization fall under this 'Rubric'. -- The constructor 'JSON' is used as a type, with DataKinds.@@ -135,6 +143,9 @@ type JSONRecord :: Symbol -> Type -> Type newtype JSONRecord objectName r = JSONRecord r +deriving via (GeneralJSONRecord 'JSON objectName r) instance (KnownSymbol objectName, Aliased 'JSON r, GRecord FromJSON (Rep r)) => FromJSON (JSONRecord objectName r) +deriving via (GeneralJSONRecord 'JSON objectName r) instance (Aliased 'JSON r, GRecord ToJSON (Rep r)) => ToJSON (JSONRecord objectName r)+ -- | Helper newtype for deriving 'FromJSON' and 'ToJSON' for sum types, -- using DerivingVia. --@@ -142,6 +153,9 @@ type JSONSum :: Symbol -> Type -> Type newtype JSONSum objectName r = JSONSum r +deriving via (GeneralJSONSum 'JSON objectName r) instance (KnownSymbol objectName, Aliased 'JSON r, GSum FromJSON (Rep r)) => FromJSON (JSONSum objectName r) +deriving via (GeneralJSONSum 'JSON objectName r) instance (Aliased 'JSON r, GSum ToJSON (Rep r)) => ToJSON (JSONSum objectName r)+ -- | Helper newtype for deriving 'FromJSON' and 'ToJSON' for enum-like sum types, -- using DerivingVia. --@@ -149,36 +163,12 @@ type JSONEnum :: Type -> Type newtype JSONEnum r = JSONEnum r -------instance (Aliased JSON r, GSum FromJSON (Rep r)) => FromJSON (JSONEnum r) where-  parseJSON v =-    let parsers =-          gToSum @FromJSON-            (aliases @JSONRubric @JSON @r)-            ( \a -> \case-                ZeroSlots x -> EnumBranchParser \case-                  String a' | a == fromText a' -> pure x-                  _ -> mempty-                SingleSlot _ -> EnumBranchParser mempty-                ManySlots _ -> EnumBranchParser mempty-            )-            Proxy-            Proxy-        parserForValue v = asum $ fmap (($ v) . runEnumBranchParser) parsers-     in JSONEnum . to <$> parserForValue v+deriving via (GeneralJSONEnum 'JSON r) instance (Aliased 'JSON r, GSum Impossible (Rep r)) => FromJSON (JSONEnum r) +deriving via (GeneralJSONEnum 'JSON r) instance (Aliased 'JSON r, GSum Impossible (Rep r)) => ToJSON (JSONEnum r)  newtype EnumBranchParser v = EnumBranchParser {runEnumBranchParser :: Value -> Parser v}   deriving stock (Functor) -instance (Aliased JSON r, GSum Impossible (Rep r)) => ToJSON (JSONEnum r) where-  toJSON (JSONEnum o) =-    let (key, slots) = gFromSum @Impossible @(Rep r) @Key @Value @Value (aliases @JSONRubric @JSON @r) absurd (from @r o)-     in case slots of-          [] -> String (toText key)-          [_] -> error "never happens"-          _ -> error "never happens"- newtype BranchParser v = BranchParser {runBranchParser :: Object -> Parser v}   deriving stock (Functor) @@ -200,15 +190,52 @@  -- ---class (x ~ Void) => Impossible x -instance (x ~ Void) => Impossible x+newtype FieldParser a = FieldParser (Object -> Parser a)+  deriving (Functor, Applicative) via ((->) Object `Compose` Parser) -instance (KnownSymbol objectName, Aliased JSON r, GSum FromJSON (Rep r)) => FromJSON (JSONSum objectName r) where+-- | A more flexible version of 'JSONSum' that lets you use any 'Rubric' whose+-- 'AliasType' is 'Data.Aeson.Key'.+-- +-- It allows deriving 'FromJSON' and 'ToJSON' for a newtype, using the generic+-- 'Rep' and the aliases of the underlying type, but __without__ defining+-- 'FromJSON' and 'ToJSON' instances for the underlying type.+-- +-- >>> :{+-- data Summy+--   = Aa Int+--   | Bb Bool+--   | Cc+--   deriving (Read, Show, Eq, Generic)+-- data JSONLocal+-- -- We define a local rubric type to avoid colliding "Aliased" instances over Foo.+-- instance Rubric JSONLocal where+--   type AliasType JSONLocal = Key+-- instance Aliased JSONLocal Summy where+--   aliases =+--     aliasListBegin+--       $ alias @"Aa" "Aax"+--       $ alias @"Bb" "Bbx"+--       $ alias @"Cc" "Cc1"+--       $ aliasListEnd+-- newtype SummyN = SummyN Summy+--     deriving (FromJSON, ToJSON) via (GeneralJSONSum JSONLocal "obj" Summy)+-- :}+--+--+type GeneralJSONSum :: rubric -> Symbol -> Type -> Type+newtype GeneralJSONSum rubric objectName r = GeneralJSONSum r++instance (+  KnownSymbol objectName, +  Rubric rubric, +  Aliased rubric r, +  AliasType rubric ~ Key, +  GSum FromJSON (Rep r)) => FromJSON (GeneralJSONSum rubric objectName r) where   parseJSON v =     let parsers =           gToSum @FromJSON-            (aliases @JSONRubric @JSON @r)+            (aliases @_ @rubric @r)             ( \a -> \case                 ZeroSlots v -> BranchParser \o -> do                   Null :: Value <- o .: a@@ -229,38 +256,141 @@                   pure (r, vs)             )         parserForObject o = asum $ fmap (($ o) . runBranchParser) parsers-     in JSONSum . to <$> withObject (symbolVal (Proxy @objectName)) parserForObject v+     in GeneralJSONSum . to <$> withObject (symbolVal (Proxy @objectName)) parserForObject v ++instance (+  Rubric rubric, +  Aliased rubric r, +  AliasType rubric ~ Key, +  GSum ToJSON (Rep r)) => ToJSON (GeneralJSONSum rubric objectName r) where+  toJSON (GeneralJSONSum o) =+    let (key, slots) = gFromSum @ToJSON @(Rep r) @Key @Value @Value (aliases @_ @rubric @r) toJSON (from @r o)+     in case slots of+          [] -> object [(key, Null)]+          [x] -> object [(key, toJSON x)]+          xs -> object [(key, toJSON xs)]+++-- | A more flexible version of 'JSONRecord' that lets you use any 'Rubric' whose+-- 'AliasType' is 'Data.Aeson.Key'.+-- +-- It allows deriving 'FromJSON' and 'ToJSON' for a newtype, using the generic+-- 'Rep' and the aliases of the underlying type, but __without__ defining+-- 'FromJSON' and 'ToJSON' instances for the underlying type.+-- +-- >>> :{+-- data Foo = Foo {aa :: Int, bb :: Bool, cc :: Char}+--   deriving (Read, Show, Eq, Generic)+-- data JSONLocal+-- -- We define a local rubric type to avoid colliding "Aliased" instances over Foo.+-- instance Rubric JSONLocal where+--   type AliasType JSONLocal = Key+-- instance Aliased JSONLocal Foo where+--   aliases =+--     aliasListBegin+--       $ alias @"aa" "aax"+--       $ alias @"bb" "bbx"+--       $ alias @"cc" "ccx"+--       $ aliasListEnd+-- newtype FooN = FooN Foo+--     deriving (FromJSON, ToJSON) via (GeneralJSONRecord JSONLocal "obj" Foo)+-- :} -- ---instance (KnownSymbol objectName, Aliased JSON r, GRecord FromJSON (Rep r)) => FromJSON (JSONRecord objectName r) where+type GeneralJSONRecord :: rubric -> Symbol -> Type -> Type+newtype GeneralJSONRecord rubric objectName r = GeneralJSONRecord r++instance (KnownSymbol objectName, +  Rubric rubric, +  Aliased rubric r, +  AliasType rubric ~ Key, +  GRecord FromJSON (Rep r)) +  => FromJSON (GeneralJSONRecord rubric objectName r) where   parseJSON v =     let FieldParser parser =           gToRecord @FromJSON-            (aliases @JSONRubric @JSON @r)+            (aliases @_ @rubric @r)             (\fieldName -> FieldParser (\o -> explicitParseField parseJSON o fieldName))         objectName = symbolVal (Proxy @objectName)-     in JSONRecord . to <$> withObject objectName parser v+     in GeneralJSONRecord . to <$> withObject objectName parser v -newtype FieldParser a = FieldParser (Object -> Parser a)-  deriving (Functor, Applicative) via ((->) Object `Compose` Parser)+instance (Rubric rubric, +  AliasType rubric ~ Key, +  Aliased rubric r, +  GRecord ToJSON (Rep r)) => ToJSON (GeneralJSONRecord rubric objectName r) where+  toJSON (GeneralJSONRecord o) =+    object $ Data.Foldable.toList $ gFromRecord @ToJSON @(Rep r) @Key (aliases @_ @rubric @r) (\a v -> (a, toJSON v)) (from @r o) +-- | A more flexible version of 'JSONEnum' that lets you use any 'Rubric' whose+-- 'AliasType' is 'Data.Aeson.Key'.+-- +-- It allows deriving 'FromJSON' and 'ToJSON' for a newtype, using the generic+-- 'Rep' and the aliases of the underlying type, but __without__ defining+-- 'FromJSON' and 'ToJSON' instances for the underlying type.+-- +-- >>> :{+-- data Enumy+--   = Xx+--   | Yy+--   | Zz+--   deriving (Read, Show, Eq, Generic)+-- data JSONLocal+-- -- We define a local rubric type to avoid colliding "Aliased" instances over Enumy.+-- instance Rubric JSONLocal where+--   type AliasType JSONLocal = Key+-- instance Aliased JSONLocal Enumy where+--   aliases =+--     aliasListBegin+--       $ alias @"Xx" "x"+--       $ alias @"Yy" "y"+--       $ alias @"Zz" "z"+--       $ aliasListEnd+-- -- We use the underlying Enumy type in DerivingVia.+-- newtype EnumyN = EnumyN Enumy+--     deriving (FromJSON, ToJSON) via (GeneralJSONEnum JSONLocal Enumy)+-- :} -- ---instance (Aliased JSON r, GSum ToJSON (Rep r)) => ToJSON (JSONSum objectName r) where-  toJSON (JSONSum o) =-    let (key, slots) = gFromSum @ToJSON @(Rep r) @Key @Value @Value (aliases @JSONRubric @JSON @r) toJSON (from @r o)-     in case slots of-          [] -> object [(key, Null)]-          [x] -> object [(key, toJSON x)]-          xs -> object [(key, toJSON xs)]+type GeneralJSONEnum :: rubric -> Type -> Type+newtype GeneralJSONEnum rubric r = GeneralJSONEnum r  -- ---instance (Aliased JSON r, GRecord ToJSON (Rep r)) => ToJSON (JSONRecord objectName r) where-  toJSON (JSONRecord o) =-    object $ Data.Foldable.toList $ gFromRecord @ToJSON @(Rep r) @Key (aliases @JSONRubric @JSON @r) (\a v -> (a, toJSON v)) (from @r o)+instance (+  Rubric rubric, +  AliasType rubric ~ Key, +  Aliased rubric r, +  GSum Impossible (Rep r)) => FromJSON (GeneralJSONEnum rubric r) where+  parseJSON v =+    let parsers =+          gToSum @Impossible+            (aliases @_ @rubric @r)+            ( \a -> \case+                ZeroSlots x -> EnumBranchParser \case+                  String a' | a == fromText a' -> pure x+                  _ -> mempty+                SingleSlot _ -> EnumBranchParser mempty+                ManySlots _ -> EnumBranchParser mempty+            )+            Proxy+            Proxy+        parserForValue v = asum $ fmap (($ v) . runEnumBranchParser) parsers+     in GeneralJSONEnum . to <$> parserForValue v +instance (+  Rubric rubric, +  AliasType rubric ~ Key, +  Aliased rubric r, +  GSum Impossible (Rep r)) +  => ToJSON (GeneralJSONEnum rubric r) where+  toJSON (GeneralJSONEnum o) =+    let (key, slots) = gFromSum @Impossible @(Rep r) @Key @Value @Value (aliases @_ @rubric @r) absurd (from @r o)+     in case slots of+          [] -> String (toText key)+          [_] -> error "never happens"+          _ -> error "never happens"+ -- $setup -- -- >>> :set -XBlockArguments@@ -271,6 +401,9 @@ -- >>> :set -XMultiParamTypeClasses -- >>> :set -XDeriveGeneric -- >>> :set -XOverloadedStrings+-- >>> :set -XTypeFamilies+-- >>> :set -XDerivingStrategies+-- >>> :set -XDerivingVia -- >>> import ByOtherNames.Aeson -- >>> import Data.Aeson -- >>> import Data.Aeson.Types

@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleInstances #-}-module ByOtherNames.Constraint (Top) where+{-# LANGUAGE TypeFamilies #-}+module ByOtherNames.Constraint (Top, Impossible) where+import Data.Void (Void)  -- | A constraint that can always be satisfied. --@@ -7,3 +9,9 @@ -- class Top x instance Top x++-- | A constraint that can't be satisfied.+--+-- Mostly useful with enum-like sum types to denote that they don't have fields.+class (x ~ Void) => Impossible x+instance (x ~ Void) => Impossible x

@@ -19,6 +19,7 @@     JSONRubric (JSON),     JSONSum (..),     JSONEnum (..),+    GeneralJSONEnum (..),     alias,     aliasListBegin,     aliasListEnd,