From 87456360ad32e18ee99184b1d0ce235827fce5b9 Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Wed, 27 Jul 2022 06:36:56 +0200 Subject: [PATCH] server: Move `ErrorMessage` to its own package. This is now the sole in-universe dependency of the schema parsers. As such, we need to extract it as a library before we can extract the schema parsers as a library. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5202 GitOrigin-RevId: fbe571855768e56dc8b8e259b8efe900de3ecc54 --- sample.hie.yaml | 17 ++++- server/graphql-engine.cabal | 5 +- .../error-message/hasura-error-message.cabal | 73 +++++++++++++++++++ server/lib/error-message/package.yaml | 53 ++++++++++++++ .../src}/Hasura/Base/ErrorMessage.hs | 13 ++-- .../src}/Hasura/Base/ErrorValue.hs | 2 +- .../src}/Hasura/Base/ToErrorValue.hs | 9 ++- .../test}/Hasura/Base/ErrorMessageSpec.hs | 11 ++- server/lib/error-message/test/Main.hs | 1 + 9 files changed, 166 insertions(+), 18 deletions(-) create mode 100644 server/lib/error-message/hasura-error-message.cabal create mode 100644 server/lib/error-message/package.yaml rename server/{src-lib => lib/error-message/src}/Hasura/Base/ErrorMessage.hs (64%) rename server/{src-lib => lib/error-message/src}/Hasura/Base/ErrorValue.hs (97%) rename server/{src-lib => lib/error-message/src}/Hasura/Base/ToErrorValue.hs (83%) rename server/{src-test => lib/error-message/test}/Hasura/Base/ErrorMessageSpec.hs (92%) create mode 100644 server/lib/error-message/test/Main.hs diff --git a/sample.hie.yaml b/sample.hie.yaml index f2506769d69..9abf4a86910 100644 --- a/sample.hie.yaml +++ b/sample.hie.yaml @@ -1,17 +1,30 @@ cradle: cabal: + - path: "./server/src-dc-api" + component: "graphql-engine:lib:dc-api" + - path: "./server/tests-dc-api" + component: "graphql-engine:test:tests-dc-api" + - path: "./server/src-lib" component: "graphql-engine:lib:graphql-engine" - path: "./server/src-exec" component: "graphql-engine:exe:graphql-engine" - path: "./server/src-test" component: "graphql-engine:test:graphql-engine-tests" + - path: "./server/src-bench-cache" component: "graphql-engine:bench:cache" - path: "server/tests-hspec" component: "graphql-engine:test:tests-hspec" + - path: "server/src-emit-metadata-openapi" component: "graphql-engine:exe:emit-metadata-openapi" - - path: "server/lib/aeson-ordered/src" - component: "lib:aeson-ordered" + + - path: "server/lib/aeson-ordered/src" + component: "aeson-ordered:lib:aeson-ordered" + + - path: "server/lib/error-message/src" + component: "hasura-error-message:lib:hasura-error-message" + - path: "server/lib/error-message/test" + component: "hasura-error-message:test:tests" diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 282e6b9e952..f16ba53973d 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -158,6 +158,7 @@ common lib-depends , dc-api , free , hashable + , hasura-error-message , http-client-tls , http-conduit , http-media @@ -424,10 +425,7 @@ library , Hasura.Metadata.Class , Hasura.Base.Error - , Hasura.Base.ErrorMessage - , Hasura.Base.ErrorValue , Hasura.Base.Instances - , Hasura.Base.ToErrorValue , Hasura.Backends.BigQuery.Connection , Hasura.Backends.BigQuery.Execute @@ -1023,7 +1021,6 @@ test-suite graphql-engine-tests Discover Hasura.AppSpec Hasura.Base.Error.TestInstances - Hasura.Base.ErrorMessageSpec Hasura.Backends.DataConnector.API.V0.AggregateSpec Hasura.Backends.DataConnector.API.V0.CapabilitiesSpec Hasura.Backends.DataConnector.API.V0.ColumnSpec diff --git a/server/lib/error-message/hasura-error-message.cabal b/server/lib/error-message/hasura-error-message.cabal new file mode 100644 index 00000000000..39882273069 --- /dev/null +++ b/server/lib/error-message/hasura-error-message.cabal @@ -0,0 +1,73 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.7. +-- +-- see: https://github.com/sol/hpack + +name: hasura-error-message +version: 1.0.0 +description: An error message type that makes it difficult to convert back to text. +homepage: https://github.com/hasura/github-engine#readme +bug-reports: https://github.com/hasura/github-engine/issues +author: Hasura, Inc. +maintainer: Hasura, Inc. +build-type: Simple +extra-source-files: + ../../../LICENSE + +source-repository head + type: git + location: https://github.com/hasura/github-engine + +library + exposed-modules: + Hasura.Base.ErrorMessage + Hasura.Base.ErrorValue + Hasura.Base.ToErrorValue + other-modules: + Paths_hasura_error_message + hs-source-dirs: + src + default-extensions: + BlockArguments + DerivingStrategies + GeneralizedNewtypeDeriving + ImportQualifiedPost + OverloadedStrings + ScopedTypeVariables + ghc-options: -Wall -Werror + build-depends: + aeson + , base + , graphql-parser + , text + , unordered-containers + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Hasura.Base.ErrorMessageSpec + Paths_hasura_error_message + hs-source-dirs: + test + default-extensions: + BlockArguments + DerivingStrategies + GeneralizedNewtypeDeriving + ImportQualifiedPost + OverloadedStrings + ScopedTypeVariables + ghc-options: -Wall -Werror -main-is Main + build-depends: + aeson + , base + , graphql-parser + , hashable + , hasura-error-message + , hspec + , text + , unordered-containers + , vector + default-language: Haskell2010 diff --git a/server/lib/error-message/package.yaml b/server/lib/error-message/package.yaml new file mode 100644 index 00000000000..75ab07e8271 --- /dev/null +++ b/server/lib/error-message/package.yaml @@ -0,0 +1,53 @@ +spec-version: 0.34.7 + +name: hasura-error-message +description: > + An error message type that makes it difficult to convert back to text. +version: 1.0.0 +author: + - Hasura, Inc. +github: hasura/github-engine + +extra-source-files: + - ../../../LICENSE + +ghc-options: + - "-Wall" + - "-Werror" + +default-extensions: + - BlockArguments + - DerivingStrategies + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - OverloadedStrings + - ScopedTypeVariables + +library: + source-dirs: + - src + dependencies: + - base + + - aeson + - graphql-parser + - text + - unordered-containers + +tests: + tests: + source-dirs: + - test + main: Main + dependencies: + - hasura-error-message + + - base + - hspec + + - aeson + - graphql-parser + - hashable + - text + - unordered-containers + - vector diff --git a/server/src-lib/Hasura/Base/ErrorMessage.hs b/server/lib/error-message/src/Hasura/Base/ErrorMessage.hs similarity index 64% rename from server/src-lib/Hasura/Base/ErrorMessage.hs rename to server/lib/error-message/src/Hasura/Base/ErrorMessage.hs index 3681b7b5669..d05b67d8e46 100644 --- a/server/src-lib/Hasura/Base/ErrorMessage.hs +++ b/server/lib/error-message/src/Hasura/Base/ErrorMessage.hs @@ -1,12 +1,13 @@ -- | Error messages -- --- This module defines a type for user facing error messages. +-- This module defines a type for user facing error messages. -- --- To construct a value of this type, use `toErrorMessage` or the 'IsString' interface, --- the type class 'ToErrorValue' defined in the "Hasura.Base.ToErrorValue" module, --- or use the utility functions defined in the "Hasura.Base.ErrorValue" module. +-- To construct a value of this type, use `toErrorMessage` or the 'IsString' +-- interface, the type class 'Hasura.Base.ToErrorValue' defined in the +-- "Hasura.Base.ToErrorValue" module, or use the utility functions defined in +-- the "Hasura.Base.ErrorValue" module. -- --- 'ErrorMessage's can also be composed using the 'Semigroup' interface. +-- 'ErrorMessage's can also be composed using the 'Semigroup' interface. module Hasura.Base.ErrorMessage ( ErrorMessage, toErrorMessage, @@ -16,8 +17,8 @@ where import Data.Aeson import Data.String (IsString (..)) +import Data.Text (Text) import Data.Text qualified as Text -import Hasura.Prelude -- | 'ErrorMessage' wraps a 'Text' value such that it's easy to build up, -- but difficult to break apart or extract the underlying text value. diff --git a/server/src-lib/Hasura/Base/ErrorValue.hs b/server/lib/error-message/src/Hasura/Base/ErrorValue.hs similarity index 97% rename from server/src-lib/Hasura/Base/ErrorValue.hs rename to server/lib/error-message/src/Hasura/Base/ErrorValue.hs index a83c9006a25..fec37e89eed 100644 --- a/server/src-lib/Hasura/Base/ErrorValue.hs +++ b/server/lib/error-message/src/Hasura/Base/ErrorValue.hs @@ -8,9 +8,9 @@ module Hasura.Base.ErrorValue ) where +import Data.Text (Text) import Data.Text qualified as Text import Hasura.Base.ErrorMessage -import Hasura.Prelude -- | Wrap error text in backticks bquote :: Text -> ErrorMessage diff --git a/server/src-lib/Hasura/Base/ToErrorValue.hs b/server/lib/error-message/src/Hasura/Base/ToErrorValue.hs similarity index 83% rename from server/src-lib/Hasura/Base/ToErrorValue.hs rename to server/lib/error-message/src/Hasura/Base/ToErrorValue.hs index a8173167d51..fdd6cab207a 100644 --- a/server/src-lib/Hasura/Base/ToErrorValue.hs +++ b/server/lib/error-message/src/Hasura/Base/ToErrorValue.hs @@ -8,15 +8,18 @@ where import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Aeson.Key import Data.Aeson.Text qualified as Aeson +import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet import Data.List qualified as List +import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NonEmpty import Data.Text.Lazy qualified as Text.Lazy +import Data.Void (Void, absurd) import Hasura.Base.ErrorMessage import Hasura.Base.ErrorValue -import Hasura.Prelude import Language.GraphQL.Draft.Syntax qualified as G +-- | A type-specific mechanism for serializing a value to an error message fragment. class ToErrorValue a where toErrorValue :: a -> ErrorMessage @@ -35,7 +38,9 @@ instance ToErrorValue () where -- Will be printed as: -- > "[1, true, \"three\"]" instance ToErrorValue a => ToErrorValue [a] where - toErrorValue values = sconcat $ "[" :| List.intersperse (toErrorMessage ", ") (map toErrorValue values) ++ ["]"] + toErrorValue values = "[" <> commaSeparatedValues <> "]" + where + commaSeparatedValues = foldr1 (<>) $ List.intersperse (toErrorMessage ", ") (map toErrorValue values) -- | Will be printed as a list instance ToErrorValue a => ToErrorValue (NonEmpty a) where diff --git a/server/src-test/Hasura/Base/ErrorMessageSpec.hs b/server/lib/error-message/test/Hasura/Base/ErrorMessageSpec.hs similarity index 92% rename from server/src-test/Hasura/Base/ErrorMessageSpec.hs rename to server/lib/error-message/test/Hasura/Base/ErrorMessageSpec.hs index 98a4b0e200e..70d66d13b55 100644 --- a/server/src-test/Hasura/Base/ErrorMessageSpec.hs +++ b/server/lib/error-message/test/Hasura/Base/ErrorMessageSpec.hs @@ -7,7 +7,10 @@ module Hasura.Base.ErrorMessageSpec (spec) where import Data.Aeson import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap +import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet +import Data.Hashable (Hashable) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Text qualified as Text import Data.Text.Lazy (unpack) import Data.Text.Lazy.Encoding (decodeUtf8) @@ -15,11 +18,13 @@ import Data.Vector qualified as Vector import Hasura.Base.ErrorMessage import Hasura.Base.ErrorValue import Hasura.Base.ToErrorValue -import Hasura.Prelude import Language.GraphQL.Draft.Syntax qualified as G import Language.GraphQL.Draft.Syntax.QQ qualified as G import Test.Hspec +-- Suppress Hasura.Prelude warnings. +{-# ANN module ("HLint: ignore Use tshow" :: String) #-} + -- Orphan instance to avoid implementing `Show ErrorMessage` in production code. instance Show ErrorMessage where -- convert to 'String' through the 'ToJSON' interface. @@ -53,7 +58,7 @@ spec = x = DoubleQuoted 'x' y = BacktickQuoted 'y' z = Parenthesized 'z' - message = sconcat $ "errors in " :| [toErrorValue w, ", ", toErrorValue x, ", ", toErrorValue y, ", and ", toErrorValue z] + message = "errors in " <> foldr1 (<>) [toErrorValue w, ", ", toErrorValue x, ", ", toErrorValue y, ", and ", toErrorValue z] in message `shouldBe` "errors in 'w', \"x\", `y`, and (z)" it "serializes GraphQL names" do @@ -101,7 +106,7 @@ newtype Thing a = Thing a deriving newtype (Eq, Hashable) instance Show a => ToErrorValue (Thing a) where - toErrorValue (Thing x) = toErrorMessage $ "Thing " <> tshow x + toErrorValue (Thing x) = toErrorMessage $ "Thing " <> Text.pack (show x) newtype SingleQuoted = SingleQuoted Char diff --git a/server/lib/error-message/test/Main.hs b/server/lib/error-message/test/Main.hs new file mode 100644 index 00000000000..a824f8c30c8 --- /dev/null +++ b/server/lib/error-message/test/Main.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}