Skip to content

Commit

Permalink
feat: add commonAesonOptions, drop deriving-aeson dependency
Browse files Browse the repository at this point in the history
Closes #2.
  • Loading branch information
vst committed Jul 21, 2022
1 parent 2e78dc9 commit 2600af4
Show file tree
Hide file tree
Showing 8 changed files with 147 additions and 26 deletions.
1 change: 0 additions & 1 deletion package.yaml
Expand Up @@ -16,7 +16,6 @@ dependencies:
- base >= 4.7 && < 5
- aeson
- bytestring
- deriving-aeson
- email-validate
- exceptions
- file-embed
Expand Down
25 changes: 15 additions & 10 deletions src/Zamazingo/Aeson.hs
Expand Up @@ -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"
}
}
16 changes: 13 additions & 3 deletions src/Zamazingo/Network/Internal/Mailing/EmailRecipientType.hs
Expand Up @@ -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"

25 changes: 20 additions & 5 deletions src/Zamazingo/Network/Internal/Mailing/Mailess.hs
Expand Up @@ -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(..))
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand Down
15 changes: 12 additions & 3 deletions src/Zamazingo/Network/Internal/Mailing/SimpleSmtpConfig.hs
Expand Up @@ -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)
Expand All @@ -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"
3 changes: 2 additions & 1 deletion test/Spec.hs
@@ -1,3 +1,4 @@
import qualified TestAeson

main :: IO ()
main = putStrLn "Test suite not yet implemented"
main = TestAeson.run
84 changes: 84 additions & 0 deletions 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
4 changes: 1 addition & 3 deletions zamazingo.cabal
Expand Up @@ -99,7 +99,6 @@ library
aeson
, base >=4.7 && <5
, bytestring
, deriving-aeson
, email-validate
, exceptions
, file-embed
Expand Down Expand Up @@ -129,7 +128,6 @@ test-suite zamazingo-doctest
aeson
, base >=4.7 && <5
, bytestring
, deriving-aeson
, doctest
, email-validate
, exceptions
Expand All @@ -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
Expand All @@ -161,7 +160,6 @@ test-suite zamazingo-test
aeson
, base >=4.7 && <5
, bytestring
, deriving-aeson
, email-validate
, exceptions
, file-embed
Expand Down

0 comments on commit 2600af4

Please sign in to comment.