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

@@ -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"
 

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

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

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

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,
+-- To construct a value of this type, use `toErrorMessage` or the 'IsString'
---   the type class 'ToErrorValue' defined in the "Hasura.Base.ToErrorValue" module,
+-- interface, the type class 'Hasura.Base.ToErrorValue' defined in the
---   or use the utility functions defined in the "Hasura.Base.ErrorValue" module.
+-- "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.

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

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

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
 

server/lib/error-message/test/Main.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}