diff --git a/package.yaml b/package.yaml index 167c8aa..47dece5 100644 --- a/package.yaml +++ b/package.yaml @@ -16,7 +16,6 @@ dependencies: - base >= 4.7 && < 5 - aeson - bytestring -- deriving-aeson - email-validate - exceptions - file-embed diff --git a/src/Zamazingo/Aeson.hs b/src/Zamazingo/Aeson.hs index 3aab3e3..cc98921 100644 --- a/src/Zamazingo/Aeson.hs +++ b/src/Zamazingo/Aeson.hs @@ -2,15 +2,20 @@ module Zamazingo.Aeson where -import qualified Data.Char as C -import qualified Deriving.Aeson as DA +import qualified Data.Aeson as Aeson +import Data.List (stripPrefix) +import Data.Maybe (fromMaybe) --- | Data definition for string modifier that lowers the first character of --- identifier. -data LowerFirst - - -instance DA.StringModifier LowerFirst where - getStringModifier "" = "" - getStringModifier (c : xs) = C.toLower c : xs +-- | Common Aeson encoding/decoding options. +commonAesonOptions :: String -> Aeson.Options +commonAesonOptions prefix = + Aeson.defaultOptions + { Aeson.omitNothingFields = True + , Aeson.fieldLabelModifier = \l -> Aeson.camelTo2 '_' . fromMaybe l $ stripPrefix prefix l + , Aeson.constructorTagModifier = \l -> Aeson.camelTo2 '_' . fromMaybe l $ stripPrefix prefix l + , Aeson.sumEncoding = Aeson.TaggedObject + { Aeson.tagFieldName = "type" + , Aeson.contentsFieldName = "value" + } + } diff --git a/src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs b/src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs index bdf4e84..c227317 100644 --- a/src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs +++ b/src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs @@ -5,7 +5,9 @@ module Zamazingo.Network.Internal.Mailing.EmailRecipientType where -import qualified Deriving.Aeson as DA +import qualified Data.Aeson as Aeson +import GHC.Generics (Generic) +import Zamazingo.Aeson (commonAesonOptions) -- | Type encoding for email recipient values (to, cc or bcc) @@ -13,5 +15,13 @@ data EmailRecipientType = EmailRecipientTypeTo | EmailRecipientTypeCc | EmailRecipientTypeBcc - deriving (Eq, DA.Generic, Ord, Show) - deriving (DA.FromJSON, DA.ToJSON) via DA.CustomJSON '[DA.ConstructorTagModifier (DA.StripPrefix "EmailRecipientType", DA.CamelToSnake)] EmailRecipientType + deriving (Eq, Generic, Ord, Show) + + +instance Aeson.FromJSON EmailRecipientType where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "EmailRecipientType" + + +instance Aeson.ToJSON EmailRecipientType where + toJSON = Aeson.genericToJSON $ commonAesonOptions "EmailRecipientType" + diff --git a/src/Zamazingo/Network/Internal/Mailing/Mailess.hs b/src/Zamazingo/Network/Internal/Mailing/Mailess.hs index bbeefca..6a23fd2 100644 --- a/src/Zamazingo/Network/Internal/Mailing/Mailess.hs +++ b/src/Zamazingo/Network/Internal/Mailing/Mailess.hs @@ -16,10 +16,11 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString as B import qualified Data.List.NonEmpty as NE import Data.Text (Text, unpack) -import qualified Deriving.Aeson.Stock as DAS +import GHC.Generics (Generic) import GHC.Stack (HasCallStack, callStack, prettyCallStack) import qualified Network.HTTP.Client.MultipartFormData as MP import qualified Network.HTTP.Simple as NS +import Zamazingo.Aeson (commonAesonOptions) import Zamazingo.Network.Internal.HttpUrl (HttpUrl) import Zamazingo.Network.Internal.Mailing.EmailAddress (EmailAddress) import Zamazingo.Network.Internal.Mailing.EmailRecipientType (EmailRecipientType(..)) @@ -35,8 +36,15 @@ import Zamazingo.Text (TextEnco newtype MailessConfig = MailessConfig { mailessConfigBaseUrl :: HttpUrl } - deriving (Eq, DAS.Generic, Show) - deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "mailessConfig" MailessConfig + deriving (Eq, Generic, Show) + + +instance Aeson.FromJSON MailessConfig where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "mailessConfig" + + +instance Aeson.ToJSON MailessConfig where + toJSON = Aeson.genericToJSON $ commonAesonOptions "mailessConfig" -- * Sending Emails @@ -149,8 +157,15 @@ data MailessMetadata a = MailessMetadata , mailessMetadataSubject :: !Text , mailessMetadataContext :: !a } - deriving (Eq, DAS.Generic, Show) - deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "mailessMetadata" (MailessMetadata a) + deriving (Eq, Generic, Show) + + +instance (Aeson.FromJSON a) => Aeson.FromJSON (MailessMetadata a) where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "mailessMetadata" + + +instance (Aeson.ToJSON a) => Aeson.ToJSON (MailessMetadata a) where + toJSON = Aeson.genericToJSON $ commonAesonOptions "mailessMetadata" -- | Low-level function to send emails over Mailess. diff --git a/src/Zamazingo/Network/Internal/Mailing/SimpleSmtpConfig.hs b/src/Zamazingo/Network/Internal/Mailing/SimpleSmtpConfig.hs index 6eab66c..82b04d7 100644 --- a/src/Zamazingo/Network/Internal/Mailing/SimpleSmtpConfig.hs +++ b/src/Zamazingo/Network/Internal/Mailing/SimpleSmtpConfig.hs @@ -6,7 +6,9 @@ module Zamazingo.Network.Internal.Mailing.SimpleSmtpConfig where -import qualified Deriving.Aeson.Stock as DAS +import qualified Data.Aeson as Aeson +import GHC.Generics (Generic) +import Zamazingo.Aeson (commonAesonOptions) import Zamazingo.Network.Internal.Host (Host) import Zamazingo.Network.Internal.Port (Port) import Zamazingo.Text (Secret) @@ -20,5 +22,12 @@ data SimpleSmtpConfig = SimpleSmtpConfig , simpleSmtpConfigPassword :: !(Maybe Secret) , simpleSmtpConfigSecure :: !(Maybe Bool) } - deriving (Eq, DAS.Generic, Ord, Show) - deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "simpleSmtpConfig" SimpleSmtpConfig + deriving (Eq, Generic, Ord, Show) + + +instance Aeson.FromJSON SimpleSmtpConfig where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "simpleSmtpConfig" + + +instance Aeson.ToJSON SimpleSmtpConfig where + toJSON = Aeson.genericToJSON $ commonAesonOptions "simpleSmtpConfig" diff --git a/test/Spec.hs b/test/Spec.hs index 02b7d6e..7b7d61d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,3 +1,4 @@ +import qualified TestAeson main :: IO () -main = putStrLn "Test suite not yet implemented" +main = TestAeson.run diff --git a/test/TestAeson.hs b/test/TestAeson.hs new file mode 100644 index 0000000..ccb2fd7 --- /dev/null +++ b/test/TestAeson.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module TestAeson where + +import qualified Data.Aeson as Aeson +import GHC.Generics (Generic) +import GHC.Stack (HasCallStack) +import Zamazingo.Aeson (commonAesonOptions) + + +run :: IO () +run = do + let student = Student 1 "A" + let studentJson = "{\"id\":1,\"name\":\"A\"}" + assert (Aeson.encode student == studentJson) $ pure () + assert (Aeson.eitherDecode studentJson == Right student) $ pure () + + let op = OpAdd + let opJson = "\"add\"" + assert (Aeson.encode op == opJson) $ pure () + assert (Aeson.eitherDecode opJson == Right op) $ pure () + + let state1 = StateLoading + let state1Json = "{\"type\":\"loading\"}" + assert (Aeson.encode state1 == state1Json) $ pure () + assert (Aeson.eitherDecode state1Json == Right state1) $ pure () + + let state2 = StateError "unknown" + let state2Json = "{\"type\":\"error\",\"value\":\"unknown\"}" + assert (Aeson.encode state2 == state2Json) $ pure () + assert (Aeson.eitherDecode state2Json == Right state2) $ pure () + + let state3 = StateResult 1 + let state3Json = "{\"type\":\"result\",\"value\":1}" + assert (Aeson.encode state3 == state3Json) $ pure () + assert (Aeson.eitherDecode state3Json == Right state3) $ pure () + + +data Student = Student + { studentId :: !Int + , studentName :: !String + } + deriving (Eq, Generic, Show) + + +instance Aeson.FromJSON Student where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "student" + + +instance Aeson.ToJSON Student where + toJSON = Aeson.genericToJSON $ commonAesonOptions "student" + + +data Op = OpAdd | OpSub | OpMul | OpDiv + deriving (Eq, Generic, Show) + + +instance Aeson.FromJSON Op where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "Op" + + +instance Aeson.ToJSON Op where + toJSON = Aeson.genericToJSON $ commonAesonOptions "Op" + + +data State = + StateLoading + | StateError String + | StateResult Int + deriving (Eq, Generic, Show) + + +instance Aeson.FromJSON State where + parseJSON = Aeson.genericParseJSON $ commonAesonOptions "State" + + +instance Aeson.ToJSON State where + toJSON = Aeson.genericToJSON $ commonAesonOptions "State" + + +assert :: HasCallStack => Bool -> a -> a +assert False _ = error "Assertion error" +assert True a = a diff --git a/zamazingo.cabal b/zamazingo.cabal index b5dc752..288a44b 100644 --- a/zamazingo.cabal +++ b/zamazingo.cabal @@ -99,7 +99,6 @@ library aeson , base >=4.7 && <5 , bytestring - , deriving-aeson , email-validate , exceptions , file-embed @@ -129,7 +128,6 @@ test-suite zamazingo-doctest aeson , base >=4.7 && <5 , bytestring - , deriving-aeson , doctest , email-validate , exceptions @@ -153,6 +151,7 @@ test-suite zamazingo-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + TestAeson Paths_zamazingo hs-source-dirs: test @@ -161,7 +160,6 @@ test-suite zamazingo-test aeson , base >=4.7 && <5 , bytestring - , deriving-aeson , email-validate , exceptions , file-embed