Merge pull request #25 from GetShopTV/no-aeson-th

Replace aeson TH with Generics-based instances
GetShopTV · Dec 19, 2015 · a6ac15f · a6ac15f
2 parents e1b45b1 + ce85903
commit a6ac15f
Show file tree

Hide file tree

Showing 3 changed files with 63 additions and 28 deletions.
diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs
@@ -9,14 +9,12 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Data.Swagger.Internal where
 
 import           Control.Applicative
 import           Control.Monad
 import           Data.Aeson
-import           Data.Aeson.TH            (deriveJSON)
 import qualified Data.Aeson.Types         as JSON
 import           Data.Data                (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
 import           Data.HashMap.Strict      (HashMap)
@@ -825,20 +823,69 @@ instance SwaggerMonoid ParamAnySchema where
   swaggerMappend _ y = y
 
 -- =======================================================================
--- TH derived ToJSON and FromJSON instances
+-- Simple Generic-based ToJSON instances
 -- =======================================================================
 
-deriveJSON (jsonPrefix "Param") ''ParamLocation
-deriveJSON' ''Info
-deriveJSON' ''Contact
-deriveJSON' ''License
-deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
-deriveJSON (jsonPrefix "apiKey") ''ApiKeyParams
-deriveJSONDefault ''Scheme
-deriveJSON' ''Tag
-deriveJSON' ''ExternalDocs
-
-deriveToJSON' ''Xml
+instance ToJSON ParamLocation where
+  toJSON = genericToJSON (jsonPrefix "Param")
+
+instance ToJSON Info where
+  toJSON = genericToJSON (jsonPrefix "Info")
+
+instance ToJSON Contact where
+  toJSON = genericToJSON (jsonPrefix "Contact")
+
+instance ToJSON License where
+  toJSON = genericToJSON (jsonPrefix "License")
+
+instance ToJSON ApiKeyLocation where
+  toJSON = genericToJSON (jsonPrefix "ApiKey")
+
+instance ToJSON ApiKeyParams where
+  toJSON = genericToJSON (jsonPrefix "apiKey")
+
+instance ToJSON Scheme where
+  toJSON = genericToJSON (jsonPrefix "")
+
+instance ToJSON Tag where
+  toJSON = genericToJSON (jsonPrefix "Tag")
+
+instance ToJSON ExternalDocs where
+  toJSON = genericToJSON (jsonPrefix "ExternalDocs")
+
+instance ToJSON Xml where
+  toJSON = genericToJSON (jsonPrefix "Xml")
+
+-- =======================================================================
+-- Simple Generic-based FromJSON instances
+-- =======================================================================
+
+instance FromJSON ParamLocation where
+  parseJSON = genericParseJSON (jsonPrefix "Param")
+
+instance FromJSON Info where
+  parseJSON = genericParseJSON (jsonPrefix "Info")
+
+instance FromJSON Contact where
+  parseJSON = genericParseJSON (jsonPrefix "Contact")
+
+instance FromJSON License where
+  parseJSON = genericParseJSON (jsonPrefix "License")
+
+instance FromJSON ApiKeyLocation where
+  parseJSON = genericParseJSON (jsonPrefix "ApiKey")
+
+instance FromJSON ApiKeyParams where
+  parseJSON = genericParseJSON (jsonPrefix "apiKey")
+
+instance FromJSON Scheme where
+  parseJSON = genericParseJSON (jsonPrefix "")
+
+instance FromJSON Tag where
+  parseJSON = genericParseJSON (jsonPrefix "Tag")
+
+instance FromJSON ExternalDocs where
+  parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
 
 -- =======================================================================
 -- Manual ToJSON instances

diff --git a/src/Data/Swagger/Internal/Utils.hs b/src/Data/Swagger/Internal/Utils.hs
@@ -8,8 +8,7 @@ module Data.Swagger.Internal.Utils where
 import Control.Arrow (first)
 import Control.Applicative
 import Data.Aeson
-import Data.Aeson.TH
-import Data.Aeson.Types (Parser, Pair)
+import Data.Aeson.Types
 import Data.Char
 import Data.Data
 import Data.Hashable (Hashable)
@@ -18,7 +17,6 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.Monoid
 import Data.Text (Text)
 import GHC.Generics
-import Language.Haskell.TH
 import Text.Read (readMaybe)
 
 gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
@@ -50,15 +48,6 @@ jsonPrefix prefix = defaultOptions
     lowerFirstUppers s = map toLower x ++ y
       where (x, y) = span isUpper s
 
-deriveToJSON' :: Name -> Q [Dec]
-deriveToJSON' name = deriveToJSON (jsonPrefix (nameBase name)) name
-
-deriveJSONDefault :: Name -> Q [Dec]
-deriveJSONDefault = deriveJSON (jsonPrefix "")
-
-deriveJSON' :: Name -> Q [Dec]
-deriveJSON' name = deriveJSON (jsonPrefix (nameBase name)) name
-
 parseOneOf :: ToJSON a => [a] -> Value -> Parser a
 parseOneOf xs js =
   case lookup js ys of

diff --git a/swagger2.cabal b/swagger2.cabal
@@ -32,13 +32,12 @@ library
     Data.Swagger.Internal.ParamSchema
     Data.Swagger.Internal.Utils
   build-depends:       base == 4.*
-                     , aeson < 0.10
+                     , aeson
                      , containers
                      , hashable
                      , http-media
                      , mtl
                      , network
-                     , template-haskell
                      , text
                      , time
                      , unordered-containers