Common Aeson Encoding/Decoding Options, Drop deriving-aeson

package.yaml

@@ -16,7 +16,6 @@ dependencies:
 - base >= 4.7 && < 5
 - aeson
 - bytestring
-- deriving-aeson
 - email-validate
 - exceptions
 - file-embed

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"
+        }
+    }

src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs

@@ -5,13 +5,23 @@
 
 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)
 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"
+

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.

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"

test/Spec.hs

@@ -1,3 +1,4 @@
+import qualified TestAeson
 
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = TestAeson.run

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

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