diff --git a/CHANGELOG.md b/CHANGELOG.md index dc19cf73..0cb068b9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,8 @@ # 0.10.0 * [#306](https://github.com/awakesecurity/proto3-suite/pull/306) 0.10.0: Use proto3-wire 1.5.0 * Support proto3-wire 1.5 instead of proto3-wire 1.4. +* Fix `--extraInstanceFile` to support standalone deriving declarations in + addition to regular instance declarations. # 0.9.5 * [#305](https://github.com/awakesecurity/proto3-suite/pull/305) Avoid unpacked packed fields diff --git a/README.md b/README.md index 2069ae2a..c572edca 100644 --- a/README.md +++ b/README.md @@ -138,10 +138,11 @@ Available options: repeated, and paths will be searched in order; the current directory is used if this option is not provided) - --extraInstanceFile FILE Additional file to provide instances that would - otherwise be generated. Can be used multiple times. - Types for which instance overrides are given must be - fully qualified. + --extraInstanceFile FILE Additional file to provide instance declarations or + standalone deriving declarations that would otherwise + be generated. Can be used multiple times. Types for + which instance overrides are given must be fully + qualified. --proto FILE Path to input .proto file --out DIR Output directory path where generated Haskell modules will be written (directory is created if it does not diff --git a/proto3-suite.cabal b/proto3-suite.cabal index 497aba19..5c252a28 100644 --- a/proto3-suite.cabal +++ b/proto3-suite.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: proto3-suite -version: 0.9.5 +version: 0.10.0 synopsis: A higher-level API to the proto3-wire library description: This library provides a higher-level API to @@ -29,6 +29,7 @@ data-files: extra-source-files: CHANGELOG.md, gen/.gitignore + test-files/extra_instances_deriving.hs flag dhall Description: Turn on Dhall interpret and inject codegen diff --git a/src/Proto3/Suite/DotProto/Generate.hs b/src/Proto3/Suite/DotProto/Generate.hs index df2c68d5..9bded71e 100644 --- a/src/Proto3/Suite/DotProto/Generate.hs +++ b/src/Proto3/Suite/DotProto/Generate.hs @@ -34,6 +34,7 @@ module Proto3.Suite.DotProto.Generate , hsModuleForDotProto , renderHsModuleForDotProto , readDotProtoWithContext + , getExtraInstances ) where import Control.Applicative @@ -256,7 +257,7 @@ hsModuleForDotProto :: , (?stringType :: StringType) , (?typeLevelFormat :: Bool) ) => - -- | Extra user-define instances that override default generated instances + -- | Extra user-defined instances and standalone deriving declarations that override default generated instances ([HsImportDecl], [HsDecl]) -> -- | DotProto -> @@ -309,8 +310,9 @@ getExtraInstances logger (Turtle.encodeString -> extraInstanceFile) = do Nothing -> internalError (T.unpack "Error: Failed to parse instance file") Just (GHC.L _ m) -> do - let isInstDecl (GHC.L _ GHC.InstD{}) = True - isInstDecl _ = False + let isInstDecl (GHC.L _ GHC.InstD{}) = True + isInstDecl (GHC.L _ GHC.DerivD{}) = True + isInstDecl _ = False pure (GHC.hsmodImports m, filter isInstDecl (GHC.hsmodDecls m)) -- | This very specific function will only work for the qualification on the very first type diff --git a/test-files/extra_instances_deriving.hs b/test-files/extra_instances_deriving.hs new file mode 100644 index 00000000..c299ef3e --- /dev/null +++ b/test-files/extra_instances_deriving.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE StandaloneDeriving #-} + +module ExtraInstances where + +data Foo = Foo + +helper :: Int +helper = 42 + +instance Show Foo where + show _ = "Foo" + +deriving instance Eq Foo diff --git a/tests/Main.hs b/tests/Main.hs index 2252d511..e1b4ee3d 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -84,7 +84,6 @@ tests logger = testGroup "Tests" , Test.Proto.Generate.Name.testTree , Test.Proto.Parse.Option.testTree , Test.Proto.Interval.testTree - #ifdef DHALL , dhallTests #endif diff --git a/tests/TestCodeGen.hs b/tests/TestCodeGen.hs index b4d50118..77015a39 100644 --- a/tests/TestCodeGen.hs +++ b/tests/TestCodeGen.hs @@ -13,6 +13,8 @@ module TestCodeGen where import ArbitraryGeneratedTestTypes () import Control.Applicative +import Control.Monad.Except (runExceptT) +import Data.List (sort) import Control.Monad #ifdef SWAGGER import qualified Data.Aeson @@ -41,7 +43,8 @@ import Proto3.Suite.DotProto (fieldLikeName, prefixedEnumFiel import Proto3.Suite.DotProto.AST (DotProtoField(..), DotProtoIdentifier(..), DotProtoType(..), DotProtoPrimType(..)) import Proto3.Suite.DotProto.Generate -import Proto3.Suite.Haskell.Parser (Logger) +import Proto3.Suite.Haskell.Parser (Logger, renderSDoc) +import qualified GHC.Utils.Outputable as GHC import Proto3.Suite.JSONPB (FromJSONPB (..), Options (..), ToJSONPB (..), defaultOptions, eitherDecode, encode, @@ -50,7 +53,7 @@ import Proto3.Suite.Types (Enumerated(..)) import System.Exit import Test.Proto.ToEncoder (Iterator, Stripping) import Test.Tasty -import Test.Tasty.HUnit (testCase, (@?=)) +import Test.Tasty.HUnit (assertEqual, assertFailure, testCase, (@?=)) import Test.Tasty.QuickCheck (Arbitrary, (===), testProperty) import qualified Turtle import qualified Turtle.Format as F @@ -72,6 +75,7 @@ codeGenTests logger = testGroup "Code generator unit tests" , don'tAlterEnumFieldNames , knownTypeMessages , pythonInteroperation logger + , extraInstanceParsing logger #ifdef SWAGGER , swaggerTests , swaggerWrapperFormat @@ -93,6 +97,22 @@ pythonInteroperation logger = testGroup "Python interoperation" $ do | otherwise -> [] pure @[] (f logger tt format) +extraInstanceParsing :: Logger -> TestTree +extraInstanceParsing logger = + testCase "getExtraInstances includes standalone deriving declarations" $ do + result <- runExceptT $ getExtraInstances logger "test-files/extra_instances_deriving.hs" + case result of + Left err -> assertFailure (show err) + Right (_imports, decls) -> do + assertEqual "expected 2 declarations (1 instance + 1 standalone deriving)" + 2 (length decls) + let names = sort (map (renderSDoc . GHC.ppr) decls) + assertEqual "parsed instance names should match the instances in extra_instances_deriving.hs" + [ "deriving instance Eq Foo" + , "instance Show Foo where\n show _ = \"Foo\"" + ] + names + #ifdef SWAGGER swaggerWrapperFormat :: TestTree swaggerWrapperFormat = testGroup "Swagger Wrapper Format" diff --git a/tools/compile-proto-file/Main.hs b/tools/compile-proto-file/Main.hs index 9a9604f6..43cda247 100644 --- a/tools/compile-proto-file/Main.hs +++ b/tools/compile-proto-file/Main.hs @@ -32,7 +32,7 @@ parseArgs = info (helper <*> parser) (fullDesc <> progDesc "Compiles a .proto fi extraInstances = many $ strOption $ long "extraInstanceFile" <> metavar "FILE" - <> help "Additional file to provide instances that would otherwise be generated. Can be used multiple times. Types for which instance overrides are given must be fully qualified." + <> help "Additional file to provide instance declarations or standalone deriving declarations that would otherwise be generated. Can be used multiple times. Types for which instance overrides are given must be fully qualified." proto = strOption $ long "proto"