aeson-generic-default (empty) → 0.1.0.0

raw patch · 6 files changed

+489/−0 lines, 6 filesdep +aesondep +aeson-generic-defaultdep +base

Dependencies added: aeson, aeson-generic-default, base, data-default, tasty, tasty-hunit, text

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +58/−0
aeson-generic-default.cabal +79/−0
src/Data/Aeson/DefaultField.hs +241/−0
test/Main.hs +76/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for aeson-default-field++## 0.1.0.0 -- 2024-10-08++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2024, Ondrej Palkovsky++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ondrej Palkovsky nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,58 @@+## aeson-generic-default++Type-level configuration of missing values for aeson FromJSON Generic parser.++Using higher-kinded-types, Coercible and Generic instances it is possible to define+a class that can be configured by a type parameter to use custom field+parsers during parsing and only when the parsing is done, it can be coerced+to use normal types.++```haskell+data ConfigFileT d = ConfigFile {+  defaultEnabled :: DefaultField d (DefBool True)+, defaultDisabled :: DefaultField d (DefBool False)+, defaultText :: DefaultField d (DefText "default text")+, defaultInt :: DefaultField d (DefInt 42)+, defaultNegativeInt :: DefaultField d (DefNegativeInt 42)+, defaultRed :: DefaultField d (DefDefault Color)+, defaultBlue :: DefaultField d (DefDefaultConstant BlueDefault)+, normalField :: T.Text+, normalOptional :: Maybe Int+} deriving (Generic)+type ConfigFile = ConfigFileT Final++instance FromJSON ConfigFile where+  parseJSON = parseWithDefaults defaultOptions+```++The resulting `ConfigFile` type alias has a form of:++```haskell+{+  defaultEnabled :: Bool+, defaultDisabled :: Bool+, defaultText :: Text+, defaultInt :: Int+, defaultNegativeInt :: Int+, defaultRed :: Color+, defaultBlue :: Color+, normalField :: T.Text+, normalOptional :: Maybe Int+}+```++The type-level configuration can be easily extended with newtypes, e.g. to create a full compatibility+layer with `singletons`:++```haskell+newtype DefSing (a :: k) = DefSing (Demote k) deriving Generic+instance (SingI a, SingKind k, FromJSON (Demote k)) => FromJSON (DefSing (a :: k)) where+  omittedField = Just $ DefSing $ fromSing (sing @a)+  parseJSON v = DefSing <$> parseJSON v+```++And then the definition of the field can be for any singleton (e.g. Bool):++```haskell+flag :: DefaultField d (DefSing True)+```

+ aeson-generic-default.cabal view

@@ -0,0 +1,79 @@+cabal-version:      3.0+name:               aeson-generic-default+version:            0.1.0.0+synopsis:           Type-level default fields for aeson Generic FromJSON parser+description:        Define default values for missing FromJSON object fields within field type declaration. ++                    It becomes handy e.g. for parsing yaml configuration files. The default values are mostly defined+                    directly at the type level so that the user doesn't have to write manual FromJSON instance.++license:            BSD-3-Clause+license-file:       LICENSE+author:             Ondrej Palkovsky+maintainer:         palkovsky.ondrej@gmail.com+-- copyright:+category:           Text, Web, JSON+build-type:         Simple+extra-doc-files:    CHANGELOG.md README.md+tested-with:        GHC == 9.2.8, GHC == 9.6.5, GHC == 9.10.1+homepage:           https://github.com/ondrap/aeson-generic-default+bug-reports:        https://github.com/ondrap/aeson-generic-default/issues++common warnings+    ghc-options: -Wall++common extensions+  default-extensions:+    AllowAmbiguousTypes+    DataKinds+    DeriveAnyClass+    DeriveFunctor+    DeriveGeneric+    DerivingVia+    DuplicateRecordFields+    FlexibleContexts+    FlexibleInstances+    GeneralizedNewtypeDeriving+    LambdaCase+    MultiParamTypeClasses+    MultiWayIf+    NamedFieldPuns+    NoMonomorphismRestriction+    OverloadedStrings+    OverloadedRecordDot+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    GADTs+    PatternSynonyms++library+    import:           warnings, extensions+    exposed-modules:  Data.Aeson.DefaultField+    build-depends:    +                      base >=4.16 && < 4.21,+                      aeson >= 2.2 && < 2.3,+                      data-default >= 0.7 && < 0.8,+                      text >= 2.0 && < 2.2+    hs-source-dirs:   src+    default-language: GHC2021++test-suite aeson-default-field-test+    import:           warnings, extensions+    default-language: GHC2021+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base,+        aeson-generic-default,+        tasty,+        tasty-hunit,+        aeson,+        text,+        data-default

+ src/Data/Aeson/DefaultField.hs view

@@ -0,0 +1,241 @@+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Module : Data.Aeson.DefaultField+-- License     : BSD-style+--+-- Maintainer  : palkovsky.ondrej@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- Type-level default fields for aeson Generic FromJSON parser +--++module Data.Aeson.DefaultField (+  -- * How to use this library+  -- $use++  -- * How to extend the library+  -- $extend++  -- * Caveats+  -- $caveats++  -- * Main field types and functions+    DefaultField+  , ParseStage(Final)+  , parseWithDefaults+  -- * Different basic types+  , DefInt(..)+  , DefNegativeInt(..)+  , DefText(..)+  , DefString(..)+  , DefBool(..)+  , DefDefault(..)+  -- * Support for newtype default constants+  , DefaultConstant(..)+  , DefDefaultConstant(..)+) where++import GHC.TypeLits (Nat, KnownNat, Symbol, KnownSymbol, natVal, symbolVal)+import Data.Aeson (FromJSON(..), genericParseJSON)+import qualified Data.Aeson as AE+import qualified Data.Text as T+import GHC.Generics+import Data.Kind (Type)+import Data.Coerce (Coercible, coerce)+import Data.Aeson.Types (Parser)+import Data.Proxy (Proxy(..))+import Data.String (fromString)+import Data.Default (Default (def))++-- | Boolean default field+newtype DefBool (a :: Bool) = DefBool Bool+  deriving (Generic)+instance FromJSON (DefBool True) where+  omittedField = Just (DefBool True)+  parseJSON v = DefBool <$> parseJSON v+instance FromJSON (DefBool False) where+  omittedField = Just (DefBool False)+  parseJSON v = DefBool <$> parseJSON v++-- | Positive Int default field (only positive numbers are supported as type parameters)+newtype DefInt (num :: Nat) = DefInt Int+  deriving (Generic)+instance KnownNat num => FromJSON (DefInt num) where+  omittedField = Just (DefInt (fromIntegral $ natVal (Proxy @num)))+  parseJSON v = DefInt <$> parseJSON v++-- | Negative Int default field+newtype DefNegativeInt (num :: Nat) = DefNegativeInt Int+  deriving (Generic)+instance KnownNat num => FromJSON (DefNegativeInt num) where+  omittedField = Just (DefNegativeInt (negate $ fromIntegral $ natVal (Proxy @num)))+  parseJSON v = DefNegativeInt <$> parseJSON v++-- | Text default field+newtype DefText (x :: Symbol) = DefText T.Text+  deriving (Generic)+instance KnownSymbol sym => FromJSON (DefText sym) where+  omittedField = Just (DefText (fromString $ symbolVal (Proxy @sym)))+  parseJSON v = DefText <$> parseJSON v++-- | String default field+newtype DefString (x :: Symbol) = DefString String+  deriving (Generic)+instance KnownSymbol sym => FromJSON (DefString sym) where+  omittedField = Just (DefString (symbolVal (Proxy @sym)))+  parseJSON v = DefString <$> parseJSON v++-- | Default field using the "Default" class+newtype DefDefault a = DefDefault a+  deriving (Generic)+instance (FromJSON a, Default a) => FromJSON (DefDefault a) where+  omittedField = Just (DefDefault def)+  parseJSON v = DefDefault <$> parseJSON v+++-- | Default class for 'DefDefaultConstant' field configuration+class (Generic a, GNewtype (Rep a)) => DefaultConstant a where+  defValue :: Proxy a -> EmbeddedType (Rep a)++-- | Use 'DefaultConstant' type as a default value for a field.+--+-- E.g. you cannot create a direct settings for real numbers; however, you can do this:+--+-- > newtype Pi = Pi Double deriving Generic+-- > instance DefaultConstant Pi where+-- >   defValue _ = 3.141592654+-- >+-- > data MyObjectT d = MyObject {+-- >   phaseAngle :: DefaultField d (DefDefaultConstant Pi)+-- > } deriving Generic+newtype DefDefaultConstant a = DefDefaultConstant (EmbeddedType (Rep a))+  deriving (Generic)+instance (DefaultConstant a, FromJSON (EmbeddedType (Rep a))) => FromJSON (DefDefaultConstant a) where+  omittedField = Just (DefDefaultConstant $ defValue (Proxy @a))+  parseJSON v = DefDefaultConstant <$> parseJSON v++-- | Kind for separating parsing with defaults and the final type+data ParseStage = +    InsertDefaults  -- ^ Use this type to instantiate the intermediate data type for parsing defaults+  | Final -- ^ Use this type to instantiate the final data type (e.g. using the type alias)++-- | Higher-kinded-type that either instantiates the field to a newtype that+-- decodes the default value if not present; or instantiates to the type+-- embedded in the newtype parameter+type family DefaultField (m :: ParseStage) a where+  DefaultField InsertDefaults a = a+  DefaultField Final a = EmbeddedType (Rep a)++-- | Copied from newtype-generics package; this way we get the type inside the newtype+class GNewtype n where+  type EmbeddedType n :: Type -- ^ Type function to retrieve the type embedded in the newtype+instance GNewtype (D1 d (C1 c (S1 s (K1 i a)))) where+  type EmbeddedType (D1 d (C1 c (S1 s (K1 i a)))) = a++-- | 'genericParseJSON' drop-in replacement+parseWithDefaults :: forall (o :: ParseStage -> Type) x. +    (AE.GFromJSON AE.Zero (Rep (o InsertDefaults))+    , Generic (o InsertDefaults), Generic (o Final)+    , Coercible (Rep (o InsertDefaults) x) (Rep (o Final) x)+    ) +    => AE.Options -> AE.Value -> Parser (o Final)+parseWithDefaults opts v = do+  (dx :: o InsertDefaults) <- genericParseJSON opts v+  return $ to @_ @x (coerce (from @_ @x dx))++-- $use+--+-- @+-- import Data.Aeson ( FromJSON(parseJSON), decode )+-- import Data.Default ( Default(..) )+-- import GHC.Generics (Generic)+-- import qualified Data.Text as T+-- import qualified Data.Aeson as AE+-- import Data.Aeson.DefaultField+-- +-- -- Define some custom datatype for json data+-- data Color = Red | Green | Blue deriving (Generic, 'FromJSON', Show)+-- +-- -- We may want a default instance for later use with 'DefDefault'+-- instance 'Default' Color where+--   def = Red+-- +-- -- Alternatively, we may create a separate default type that would be coerced back+-- -- to Color with 'DefDefaultConstant'. This allows for different default values+-- -- with the same type for different fields.+-- newtype BlueDefault = BlueDefault Color deriving Generic+-- instance 'DefaultConstant' BlueDefault where+--   defValue _ = Blue+-- +-- -- Simply create the data object we want to parse from the file; add a type parameter+-- -- so that we can use the type family magic to create 2 different type representations.+-- -- Normal fields act normally. Use 'DefaultField' with the appropriate settings+-- -- to configure the parsing of the missing fields. Null fields are NOT replaced+-- -- with the default value; only missing fields are.+-- data ConfigFileT d = ConfigFile {+--     defaultEnabled :: 'DefaultField' d ('DefBool' True)+--   , defaultDisabled :: 'DefaultField' d ('DefBool' False)+--   , defaultText :: 'DefaultField' d ('DefText' "default text")+--   , defaultInt :: 'DefaultField' d ('DefInt' 42)+--   , defaultNegativeInt :: 'DefaultField' d ('DefNegativeInt' 42)+--   , defaultRed :: 'DefaultField' d ('DefDefault' Color)+--   , defaultBlue :: 'DefaultField' d ('DefDefaultConstant' BlueDefault)+--   , normalField :: T.Text+--   , normalOptional :: Maybe Int+-- } deriving (Generic)+-- +-- -- Create a type alias so that we can (mostly) handle the type as if nothing special+-- -- was happening under the hood.+-- type ConfigFile = ConfigFileT 'Final'+-- deriving instance Show ConfigFile+-- +-- -- Create a custom parsing instance for the data object. +-- instance FromJSON ConfigFile where+--   parseJSON = 'parseWithDefaults' AE.defaultOptions{AE.rejectUnknownFields=True}+--+-- @+-- +-- >>> AE.decode "{\"defaultDisabled\":true,\"normalField\":\"text\"}" :: Maybe ConfigFile+-- >>> Just (ConfigFile {+--           defaultEnabled = True+--         , defaultDisabled = True+--         , defaultText = "default text"+--         , defaultInt = 42+--         , defaultNegativeInt = -42+--         , defaultRed = Red+--         , defaultBlue = Blue+--         , normalField = "text"+--         , normalOptional = Nothing}+--         )++-- $extend+--+-- The provided 'DefText', 'DefInt', etc. newtypes should provide enough flexibility to configure the missing+-- fields for the objects. If a special type of configuration is needed, a /newtype/+-- based on a final type must be created with 'Generic' and 'FromJSON' instances.+-- See the source code for examples.+--+-- The default newtypes do not replace null value with the default value. You can create your own+-- types that behave differently.+--+-- E.g. a configuration that would use the singletons package is:+--+-- > newtype DefSing (a :: k) = DefSing (Demote k) deriving Generic+-- > instance (SingI a, SingKind k, FromJSON (Demote k)) => FromJSON (DefSing (a :: k)) where+-- >  omittedField = Just $ DefSing $ fromSing (sing @a)+-- >  parseJSON v = DefSing <$> parseJSON v+--+-- The configuration would then be:+--+-- > defaultBool :: DefaultField d (DefSing False)++-- $caveats+--+-- The final step in the parsing is coercing the structure with newtypes (e.g. 'DefBool') to +-- a structure with the final types (e.g. Bool). Unfortunately, the type families in Haskell +-- cause the type not to be directly coercible between the intermediate and the 'Final' stage.+-- However, it is possible through the Generic instances.+--+-- This solution probably brings some performance degradation in the sense that the structure+-- must be recreated. Benchmark before use in performance-sensitive situations.

+ test/Main.hs view

@@ -0,0 +1,76 @@+module Main (main) where++import Test.Tasty+import Test.Tasty.HUnit+import qualified Data.Aeson as AE+import Data.Aeson.DefaultField+import GHC.Generics (Generic)+import Data.Default (Default(..))+import qualified Data.Text as T+import Data.Aeson (FromJSON(..))+import Data.Either (isLeft)++data Color = Red | Green | Blue+  deriving (Show, Eq, Generic, FromJSON)+instance Default Color where+  def = Red++newtype BlueDefault = BlueDefault Color deriving Generic+instance DefaultConstant BlueDefault where+  defValue _ = Blue++data ConfigFileT d = ConfigFile {+  defaultEnabled :: DefaultField d (DefBool True)+, defaultDisabled :: DefaultField d (DefBool False)+, defaultText :: DefaultField d (DefText "default text")+, defaultInt :: DefaultField d (DefInt 42)+, defaultNegativeInt :: DefaultField d (DefNegativeInt 42)+, defaultRed :: DefaultField d (DefDefault Color)+, defaultBlue :: DefaultField d (DefDefaultConstant BlueDefault)+, normalField :: T.Text+, normalOptional :: Maybe Int+} deriving (Generic)++type ConfigFile = ConfigFileT Final+deriving instance Show ConfigFile+deriving instance Eq ConfigFile+instance FromJSON ConfigFile where+  parseJSON = parseWithDefaults AE.defaultOptions+++main :: IO ()+main = defaultMain $ testGroup "Tests" [+    testCase "Basic empty input" $ do+      let decoded = AE.eitherDecode "{\"normalField\":\"input\"}"+          expectedResult1 :: ConfigFile+          expectedResult1 = ConfigFile {+            defaultEnabled = True+          , defaultDisabled = False+          , defaultText = "default text"+          , defaultInt = 42+          , defaultNegativeInt = -42+          , defaultRed = Red+          , defaultBlue = Blue+          , normalField = "input"+          , normalOptional = Nothing+          }+      decoded @?= Right expectedResult1+  , testCase "Basic partial input" $ do+      let decoded = AE.eitherDecode "{\"normalField\":\"input\", \"defaultEnabled\":false,\"defaultRed\":\"Green\", \"defaultNegativeInt\":2}"+          expectedResult1 :: ConfigFile+          expectedResult1 = ConfigFile {+            defaultEnabled = False+          , defaultDisabled = False+          , defaultText = "default text"+          , defaultInt = 42+          , defaultNegativeInt = 2+          , defaultRed = Green+          , defaultBlue = Blue+          , normalField = "input"+          , normalOptional = Nothing+          }+      decoded @?= Right expectedResult1+  , testCase "Basic null input" $ do+      let decoded = AE.eitherDecode "{\"normalField\":\"input\", \"defaultEnabled\":null}" :: Either String ConfigFile+      assertBool "Should fail on null value in default field" (isLeft decoded)+  ]