aeson-default (empty) → 0.9.0.0
raw patch · 12 files changed
+705/−0 lines, 12 filesdep +aesondep +aeson-defaultdep +basesetup-changed
Dependencies added: aeson, aeson-default, base, containers
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- aeson-default.cabal +60/−0
- src/Data/Aeson/Default.hs +85/−0
- src/Data/Aeson/Default/Class.hs +152/−0
- src/Data/Aeson/Default/HKD.hs +15/−0
- src/Data/Aeson/Default/List.hs +53/−0
- src/Data/Aeson/Default/Map/Lazy.hs +64/−0
- src/Data/Aeson/Default/Map/Strict.hs +64/−0
- test/Main.hs +172/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for hkd-default++## v0.9.0+- Rename `hkd-default` to `aeson-default`+- Make some improvements
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Version Cloud (c) 2020++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 Jorah Gao 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,3 @@+# aeson-default [](http://hackage.haskell.org/package/aeson-default) [](https://travis-ci.org/versioncloud/aeson-default) [](https://ci.appveyor.com/project/gqk007/aeson-default/branch/master)++Please see http://hackage.haskell.org/package/aeson-default
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aeson-default.cabal view
@@ -0,0 +1,60 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: de684a68592377ef48a9a702e9beb7ab67ad11d32bec169b44cfc7e9501187ec++name: aeson-default+version: 0.9.0.0+synopsis: Applying default value to FromJSON instacnes' Maybe fields+description: Please see http://hackage.haskell.org/package/hkd-default+category: HKD, Default, JSON, Library+homepage: https://github.com/versioncloud/hkd-default#readme+bug-reports: https://github.com/versioncloud/hkd-default/issues+author: Jorah Gao+maintainer: jorah@version.cloud+copyright: Copyright (c) 2020 Version Cloud+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/versioncloud/hkd-default++library+ exposed-modules:+ Data.Aeson.Default+ Data.Aeson.Default.HKD+ Data.Aeson.Default.List+ Data.Aeson.Default.Map.Lazy+ Data.Aeson.Default.Map.Strict+ other-modules:+ Data.Aeson.Default.Class+ hs-source-dirs:+ src+ build-depends:+ aeson >=1.2 && <2+ , base >=4.7 && <5+ , containers >=0.5.10 && <1+ default-language: Haskell2010++test-suite aeson-default-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_aeson_default+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0+ build-depends:+ aeson >=1.2 && <2+ , aeson-default+ , base >=4.7 && <5+ , containers >=0.5.10 && <1+ default-language: Haskell2010
+ src/Data/Aeson/Default.hs view
@@ -0,0 +1,85 @@+{-| This library provides a solution for applying a default value to+ 'Maybe' fields of 'FromJSON' instances.+You should know a little bit about the __higher-kinded data__(HKD), here is+an [article](https://reasonablypolymorphic.com/blog/higher-kinded-data/)+on this topic.++=== Examples++See "Logging.Config.Type" in [log4hs](http://hackage.haskell.org/package/log4hs)+package for more information on how to use this library in a real project.++>>> :set -XDeriveGeneric+>>> :set -XFlexibleInstances+>>> :set -XFlexibleContexts+>>> :set -XStandaloneDeriving+>>> import Data.Functor.Identity+>>> import GHC.Generics+>>> import Data.Aeson+>>> import Data.Aeson.Default+>>> :{+data NameH f = Name { first :: String+ , middle :: f String+ , last_ :: String+ } deriving Generic+instance FromJSON (NameH Maybe)+instance Default NameH where+ constrDef _ = Name "Jorah" (Identity ".") "Gao"+deriving instance Show (NameH Identity)+data PersonH f = Person { name :: NameH f+ , age :: f Int+ } deriving Generic+instance FromJSON (PersonH Maybe)+instance Default PersonH where+ constrDef _ = Person (constrDef "Name") (Identity 28)+deriving instance Show (PersonH Identity)+:}+>>> decode "{\"first\":\"jorah\", \"last_\": \"gao\"}" :: Maybe (NameH Identity)+Just (Name {first = "jorah", middle = Identity ".", last_ = "gao"})+>>> decode "{\"first\":\"jorah\", \"middle\": \"*\", \"last_\": \"gao\"}" :: Maybe (NameH Identity)+Just (Name {first = "jorah", middle = Identity "*", last_ = "gao"})++>>> :set -XDeriveGeneric+>>> :set -XFlexibleInstances+>>> :set -XFlexibleContexts+>>> :set -XStandaloneDeriving+>>> :set -XTypeFamilies+>>> import Data.Functor.Identity+>>> import GHC.Generics+>>> import Data.Aeson+>>> import Data.Aeson.Default+>>> import Data.Aeson.Default.HKD+>>> :{+data ShapeH f = Square { side :: HKD Double f }+ | Circle { redius :: HKD Double f }+ deriving Generic+instance FromJSON (ShapeH Maybe)+instance Default ShapeH where+ constrDef "Square" = Square 1.0+ constrDef "Circle" = Circle 1.0+deriving instance Show (ShapeH Identity)+data BoxH f = Box { base :: HKD (ShapeH f) f+ , height :: HKD Double f+ } deriving Generic+instance FromJSON (BoxH Maybe)+instance Default BoxH where+ constrDef _ = Box (constrDef "Square") 1.0+deriving instance Show (BoxH Identity)+:}+>>> decode "{}" :: Maybe (BoxH Identity)+Just (Box {base = Square {side = 1.0}, height = 1.0})+>>> decode "{\"base\": {\"tag\": \"Square\"}}" :: Maybe (BoxH Identity)+Just (Box {base = Square {side = 1.0}, height = 1.0})+>>> decode "{\"base\": {\"tag\": \"Circle\"}}" :: Maybe (BoxH Identity)+Just (Box {base = Circle {redius = 1.0}, height = 1.0})+>>> decode "{\"base\": {\"tag\": \"Square\", \"side\": 10.0}}" :: Maybe (BoxH Identity)+Just (Box {base = Square {side = 10.0}, height = 1.0})+>>> decode "{\"height\": 10.0}" :: Maybe (BoxH Identity)+Just (Box {base = Square {side = 1.0}, height = 10.0})+-}+module Data.Aeson.Default+ ( module Data.Aeson.Default.Class+ ) where+++import Data.Aeson.Default.Class
+ src/Data/Aeson/Default/Class.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Aeson.Default.Class+ ( Default(..)+ ) where+++import Data.Aeson+import Data.Functor.Identity+import Data.Kind+import Data.Maybe+import GHC.Generics+++data Mismatch = Mismatch+++{-| In most cases, use the default implementation for 'Generic' instances.++Since 'Default' instances have implemented 'FromJSON' (t 'Maybe'),+all 'Default' instances will automatically implement 'FromJSON' (t 'Identity').+-}+class FromJSON (t Maybe) => Default (t :: (Type -> Type) -> Type) where+ -- | Get default value by the data constructor name.+ constrDef :: String -> t Identity++ {-| Apply the given default value, if the data constructor does not match,+ call 'constrDef' to get the correct value and then apply it again, if it does+ not match either, raise an error.++ There is a default implementation for 'Generic' instances.+ -}+ applyDef :: t Identity -> t Maybe -> t Identity++ default applyDef :: ( Generic (t Identity)+ , Generic (t Maybe)+ , GDefault (Rep (t Identity)) (Rep (t Maybe))+ , GConsName (Rep (t Identity))+ , GConsName (Rep (t Maybe))+ )+ => t Identity -> t Maybe -> t Identity+ applyDef i m | Right r <- gapplyDef (from i) (from m) = to r+ applyDef _ m = retry (constrDef $ gconsName $ from m) m+ where+ retry :: ( Generic (t Identity)+ , Generic (t Maybe)+ , GDefault (Rep (t Identity)) (Rep (t Maybe))+ , GConsName (Rep (t Identity))+ , GConsName (Rep (t Maybe))+ )+ => t Identity -> t Maybe -> t Identity+ retry i m | Right r <- gapplyDef (from i) (from m) = to r+ retry i m = error $+ "Data.Aeson.Default: The data constructor (" ++ (gconsName (from i)) +++ ") of the default value you provide (or constrDef returns) " +++ " does not match expected (" ++ (gconsName (from m)) ++ ")."++ applyDefs :: t Maybe -> t Identity++ -- | Call 'constrDef' to get the default value, then call 'applyDef' to apply+ -- it.+ default applyDefs :: ( Generic (t Maybe)+ , GConsName (Rep (t Maybe))+ )+ => t Maybe -> t Identity+ applyDefs m = applyDef (constrDef $ gconsName $ from m) m++instance Default t => FromJSON (t Identity) where+ parseJSON = (fmap applyDefs) . parseJSON+++--------------------------------------------------------------------------------+class GDefault f g where+ gapplyDef :: f (t Identity) -> g (t Maybe) -> Either Mismatch (f (t Identity))++-- Data type+instance GDefault f g => GDefault (D1 c f) (D1 c g) where+ gapplyDef (M1 p) (M1 k) = M1 <$> gapplyDef p k++-- Choice between data constructors+instance ( GDefault f g+ , GDefault f' g'+ ) => GDefault (f :+: f') (g :+: g') where+ gapplyDef (L1 p) (L1 k) = L1 <$> gapplyDef p k+ gapplyDef (R1 p) (R1 k) = R1 <$> gapplyDef p k+ gapplyDef _ _ = Left Mismatch++-- Data constructor+instance ( Constructor c+ , GDefault f g+ ) => GDefault (C1 c f) (C1 c g) where+ gapplyDef (M1 p) (M1 k) = M1 <$> gapplyDef p k++-- Enum type (nullary data constructor)+instance Constructor c => GDefault (C1 c U1) (C1 c U1) where+ gapplyDef (M1 p) (M1 k) = Right $ M1 p++-- Apply record selectors+instance ( GDefault f g+ , GDefault f' g'+ ) => GDefault (f :*: f') (g :*: g') where+ gapplyDef (p :*: p') (k :*: k') = do+ x <- gapplyDef p k+ y <- gapplyDef p' k'+ return $ x :*: y++-- Selector+instance (Selector c , GDefault f g) => GDefault (S1 c f) (S1 c g) where+ gapplyDef (M1 p) (M1 k) = M1 <$> gapplyDef p k++-- Not nested required field+instance GDefault (K1 i f) (K1 i f) where+ gapplyDef (K1 p) (K1 k) = Right $ K1 k++-- Not nested optional field (use type family)+instance GDefault (K1 i f) (K1 i (Maybe f)) where+ gapplyDef (K1 p) (K1 k) = Right $ K1 $ fromMaybe p k++-- Not nested optional field (not use type family)+instance GDefault (K1 i (Identity f)) (K1 i (Maybe f)) where+ gapplyDef (K1 p) (K1 Nothing) = Right $ K1 p+ gapplyDef (K1 p) (K1 (Just k)) = Right $ K1 $ Identity k++-- Nested required field+instance Default t => GDefault (K1 i (t Identity)) (K1 i (t Maybe)) where+ gapplyDef (K1 p) (K1 k) = Right $ K1 $ applyDef p k++-- Nested optional field+instance Default t => GDefault (K1 i (t Identity)) (K1 i (Maybe (t Maybe))) where+ gapplyDef (K1 p) (K1 Nothing) = Right $ K1 p+ gapplyDef (K1 p) (K1 (Just k)) = Right $ K1 $ applyDef p k+++class GConsName f where+ gconsName :: f p -> String++instance GConsName f => GConsName (D1 c f) where+ gconsName (M1 x) = gconsName x++instance (GConsName f, GConsName g)=> GConsName (f :+: g) where+ gconsName (L1 x) = gconsName x+ gconsName (R1 x) = gconsName x++instance Constructor c => GConsName (C1 c f) where+ gconsName = conName
+ src/Data/Aeson/Default/HKD.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TypeFamilies #-}++module Data.Aeson.Default.HKD ( HKD(..) ) where++import Data.Functor.Identity+++{- | Wrap a datatype as __higer-kind data__.++Using the HKD type family means that GHC will automatically erase any Identity+wrappers in our representations.+-}+type family HKD a f where+ HKD a Identity = a+ HKD a f = f a
+ src/Data/Aeson/Default/List.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Aeson.Default.List where++import Data.Aeson+import Data.Aeson.Default.Class+import Data.Kind+import GHC.Exts (IsList (..))+#if MIN_VERSION_base(4, 9, 0)+import Data.Semigroup+#endif++-- | A 'higher-kined' List.+newtype ListH (t :: (Type -> Type) -> Type) f = ListH { unListH :: [t f] }++instance IsList (ListH t f) where+ type Item (ListH t f) = t f+ fromList = ListH . fromList+ toList (ListH x) = toList x++instance Eq (t f) => Eq (ListH t f) where+ (ListH x) == (ListH y) = x == y++instance Show (t f) => Show (ListH t f) where+ show (ListH x) = show x++instance Read (t f) => Read (ListH t f) where+ readsPrec n s = [(ListH x, s) | (x, s') <- readsPrec n s]++#if MIN_VERSION_base(4, 9, 0)+instance Semigroup (ListH t f) where+ (ListH x) <> (ListH y) = ListH (x <> y)+#endif++instance Monoid (ListH t f) where+ mempty = ListH mempty+ mappend (ListH x) (ListH y) = ListH (mappend x y)++instance FromJSON (t Maybe) => FromJSON (ListH t Maybe) where+ parseJSON = (fmap ListH) . parseJSON++instance (Default t, FromJSON (ListH t Maybe)) => Default (ListH t) where+ constrDef _ = mempty++ applyDef is (ListH []) = is+ applyDef _ (ListH ms) = ListH $ map applyDefs ms++ applyDefs = applyDef $ constrDef "ListH"
+ src/Data/Aeson/Default/Map/Lazy.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Aeson.Default.Map.Lazy where++import Data.Aeson+import Data.Aeson.Default.Class+import Data.Kind+import Data.Map.Lazy hiding (fromList, toList)+import GHC.Exts (IsList (..))+import GHC.Generics+import Prelude hiding (lookup, map)+#if MIN_VERSION_base(4, 9, 0)+import Data.Semigroup+#endif+++-- | A 'higer-kinded' Lazy Map.+newtype MapH k (t :: (Type -> Type) -> Type) f = MapH { unMapH :: Map k (t f) }++instance Ord k => IsList (MapH k t f) where+ type Item (MapH k t f) = (k,t f)+ fromList = MapH . fromList+ toList (MapH x) = toList x++instance (Eq k, Eq (t f)) => Eq (MapH k t f) where+ (MapH x) == (MapH y) = x == y++instance (Show k, Show (t f)) => Show (MapH k t f) where+ show (MapH x) = show x++instance (Ord k, Ord (t f)) => Ord (MapH k t f) where+ compare (MapH x) (MapH y) = compare x y++instance (Ord k, Read k, Read (t f)) => Read (MapH k t f) where+ readsPrec n s = [(MapH x, s') | (x, s') <- readsPrec n s]++#if MIN_VERSION_base(4, 9, 0)+instance Ord k => Semigroup (MapH k t f) where+ (MapH x) <> (MapH y) = MapH (x <> y)+#endif++instance Ord k => Monoid (MapH k t f) where+ mempty = MapH mempty+ mappend (MapH x) (MapH y) = MapH (mappend x y)++instance (Ord k, FromJSONKey k, FromJSON (t Maybe)+ ) => FromJSON (MapH k t Maybe) where+ parseJSON = (fmap MapH) . parseJSON++instance (Ord k, Default t, FromJSON (MapH k t Maybe)+ ) => Default (MapH k t) where+ constrDef _ = mempty++ applyDef (MapH is) (MapH ms) = MapH $ mapWithKey applyItem ms+ where+ applyItem k m | Just i <- lookup k is = applyDef i m+ applyItem _ m = applyDefs m++ applyDefs = applyDef $ constrDef "MapH"
+ src/Data/Aeson/Default/Map/Strict.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Aeson.Default.Map.Strict where++import Data.Aeson+import Data.Aeson.Default.Class+import Data.Kind+import Data.Map.Strict hiding (fromList, toList)+import GHC.Exts (IsList (..))+import GHC.Generics+import Prelude hiding (lookup, map)+#if MIN_VERSION_base(4, 9, 0)+import Data.Semigroup+#endif+++-- | A 'higer-kinded' Strict Map.+newtype MapH k (t :: (Type -> Type) -> Type) f = MapH { unMapH :: Map k (t f) }++instance Ord k => IsList (MapH k t f) where+ type Item (MapH k t f) = (k,t f)+ fromList = MapH . fromList+ toList (MapH x) = toList x++instance (Eq k, Eq (t f)) => Eq (MapH k t f) where+ (MapH x) == (MapH y) = x == y++instance (Show k, Show (t f)) => Show (MapH k t f) where+ show (MapH x) = show x++instance (Ord k, Ord (t f)) => Ord (MapH k t f) where+ compare (MapH x) (MapH y) = compare x y++instance (Ord k, Read k, Read (t f)) => Read (MapH k t f) where+ readsPrec n s = [(MapH x, s') | (x, s') <- readsPrec n s]++#if MIN_VERSION_base(4, 9, 0)+instance Ord k => Semigroup (MapH k t f) where+ (MapH x) <> (MapH y) = MapH (x <> y)+#endif++instance Ord k => Monoid (MapH k t f) where+ mempty = MapH mempty+ mappend (MapH x) (MapH y) = MapH (mappend x y)++instance (Ord k, FromJSONKey k, FromJSON (t Maybe)+ ) => FromJSON (MapH k t Maybe) where+ parseJSON = (fmap MapH) . parseJSON++instance (Ord k, Default t, FromJSON (MapH k t Maybe)+ ) => Default (MapH k t) where+ constrDef _ = mempty++ applyDef (MapH is) (MapH ms) = MapH $ mapWithKey applyItem ms+ where+ applyItem k m | Just i <- lookup k is = applyDef i m+ applyItem _ m = applyDefs m++ applyDefs = applyDef $ constrDef "MapH"
+ test/Main.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}++module Main ( main ) where+++import Control.Exception (assert)+import Data.Aeson+import Data.Aeson.Default+import Data.Aeson.Default.HKD+import Data.Aeson.Default.List+import Data.Aeson.Default.Map.Lazy+import Data.Functor.Identity+import Data.Map.Lazy+import Data.Maybe+import GHC.Generics+++data NameH f = Name { first :: String+ , middle :: f String+ , last_ :: String+ } deriving Generic++instance FromJSON (NameH Maybe)++instance Default NameH where+ constrDef _ = Name "Jorah" (Identity ".") "Gao"++deriving instance Eq (NameH Identity)+++data PersonH f = Person { name :: NameH f+ , age :: f Int+ } deriving Generic++instance FromJSON (PersonH Maybe)++instance Default PersonH where+ constrDef _ = Person (constrDef "Name") (Identity 28)++deriving instance Eq (PersonH Identity)+++data DBH f = DB { host :: HKD String f+ , port :: HKD Int f+ } deriving Generic++instance FromJSON (DBH Maybe)++instance Default DBH where+ constrDef _ = DB "localhost" 3306++deriving instance Eq (DBH Identity)+++data ConfigH f = Config { db :: HKD (DBH f) f } deriving Generic++instance FromJSON (ConfigH Maybe)++instance Default ConfigH where+ constrDef _ = Config (constrDef "DB")++deriving instance Eq (ConfigH Identity)+++data ShapeH f = Square { side :: HKD Double f }+ | Circle { redius :: HKD Double f }+ deriving Generic++instance FromJSON (ShapeH Maybe)++instance Default ShapeH where+ constrDef "Square" = Square 1.0+ constrDef "Circle" = Circle 1.0++deriving instance Eq (ShapeH Identity)+++data BoxH f = Box { base :: HKD (ShapeH f) f+ , height :: HKD Double f+ } deriving Generic++instance FromJSON (BoxH Maybe)++instance Default BoxH where+ constrDef _ = Box (constrDef "Square") 1.0++deriving instance Eq (BoxH Identity)+++data HandlerH f = Handler { level :: HKD String f+ , filterer :: HKD [String] f+ } deriving Generic++instance FromJSON (HandlerH Maybe)++instance Default HandlerH where+ constrDef _ = Handler "INFO" []++deriving instance Eq (HandlerH Identity)+++data SinkH f = Sink { handlers :: HKD (ListH HandlerH f) f } deriving Generic++instance FromJSON (SinkH Maybe)++instance Default SinkH where+ constrDef _ = Sink (constrDef "ListH")++deriving instance Eq (SinkH Identity)+++data ManagerH f = Manager { sinks :: HKD (MapH String SinkH f) f+ } deriving Generic++instance FromJSON (ManagerH Maybe)++instance Default ManagerH where+ constrDef _ = Manager $ constrDef "MapH"++deriving instance Eq (ManagerH Identity)+++it :: String -> Bool -> IO ()+it = flip assert . putStrLn++main :: IO ()+main = do+ putStrLn "\n<<<<<<<<<<<<<<<<<<<<<< Test <<<<<<<<<<<<<<<<<<<<<<"++ it "flatten data" $+ let res1 = decode "{\"first\":\"Jorah\", \"last_\": \"Gao\"}" == Just (Name "Jorah" (Identity ".") "Gao")+ res2 = decode "{\"first\":\"Jorah1\", \"last_\": \"Gao2\"}" == Just (Name "Jorah1" (Identity ".") "Gao2")+ res3 = decode "{\"first\":\"Jorah3\", \"middle\": \"*\", \"last_\": \"Gao4\"}" == Just (Name "Jorah3" (Identity "*") "Gao4")+ res4 = decode "{}" == Just (DB "localhost" 3306 :: DBH Identity)+ res5 = decode "{\"host\": \"127.0.0.1\"}" == Just (DB "127.0.0.1" 3306 :: DBH Identity)+ res6 = decode "{\"port\": 3307}" == Just (DB "localhost" 3307 :: DBH Identity)+ res7 = decode "{\"host\": \"127.0.0.1\", \"port\": 3307}" == Just (DB "127.0.0.1" 3307 :: DBH Identity)+ in all id [res1, res2, res3, res4, res5, res6, res7]+ it "nested data" $+ let res1 = decode "{\"name\": {\"first\": \"Jorah5\", \"last_\": \"Gao6\"}}" == Just (Person (Name "Jorah5" (Identity ".") "Gao6") (Identity 28))+ res2 = decode "{\"name\": {\"first\": \"Jorah5\", \"last_\": \"Gao6\"}, \"age\": 82}" == Just (Person (Name "Jorah5" (Identity ".") "Gao6") (Identity 82))+ res3 = decode "{}" == Just (Config (DB "localhost" 3306) :: ConfigH Identity)+ res4 = decode "{\"db\": {}}" == Just (Config (DB "localhost" 3306) :: ConfigH Identity)+ res5 = decode "{\"db\": {\"host\": \"127.0.0.1\"}}" == Just (Config (DB "127.0.0.1" 3306) :: ConfigH Identity)+ res6 = decode "{\"db\": {\"port\": 3307}}" == Just (Config (DB "localhost" 3307) :: ConfigH Identity)+ res7 = decode "{\"db\": {\"host\": \"127.0.0.1\", \"port\": 3307}}" == Just (Config (DB "127.0.0.1" 3307) :: ConfigH Identity)+ in all id [res1, res2, res3, res4, res5, res6, res7]+ it "multiple data constructors" $+ let res1 = decode "{}" == Just (Box (Square 1.0) 1.0 :: BoxH Identity)+ res2 = decode "{\"base\": {\"tag\": \"Square\"}}" == Just (Box (Square 1.0) 1.0 :: BoxH Identity)+ res3 = decode "{\"base\": {\"tag\": \"Circle\"}}" == Just (Box (Circle 1.0) 1.0 :: BoxH Identity)+ res4 = decode "{\"base\": {\"tag\": \"Square\", \"side\": 10.0}}" == Just (Box (Square 10.0) 1.0 :: BoxH Identity)+ res5 = decode "{\"base\": {\"tag\": \"Circle\", \"redius\": 10.0}}" == Just (Box (Circle 10.0) 1.0 :: BoxH Identity)+ res6 = decode "{\"height\": 10.0}" == Just (Box (Square 1.0) 10.0 :: BoxH Identity)+ in all id [res1, res2, res3, res4, res5, res6]+ it "higher-kined container types" $+ let res1 = decode "{}" == Just (Manager mempty :: ManagerH Identity)+ res2 = decode "{\"sinks\": {}}" == Just (Manager mempty :: ManagerH Identity)+ res3 = decode "{\"sinks\": {\"root\": {}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty)]) :: ManagerH Identity)+ res4 = decode "{\"sinks\": {\"root\": {}, \"root1\": {}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty), ("root1", Sink mempty)]) :: ManagerH Identity)+ res5 = decode "{\"sinks\": {\"root\": {\"handlers\": []}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty)]) :: ManagerH Identity)+ res6 = decode "{\"sinks\": {\"root\": {\"handlers\": [{}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" []])]) :: ManagerH Identity)+ res7 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"level\": \"DEBUG\"}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "DEBUG" []])]) :: ManagerH Identity)+ res8 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"filterer\": []}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" []])]) :: ManagerH Identity)+ res9 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"filterer\": [\"A\"]}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" ["A"]])]) :: ManagerH Identity)+ res10 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"level\": \"DEBUG\", \"filterer\": [\"A\"]}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "DEBUG" ["A"]])]) :: ManagerH Identity)+ in all id [res1, res2, res3, res4, res5, res6, res7, res8, res9, res10]++ putStrLn "\n>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"