From 131576e56cb4981938320569dfcf1ca814d8a42a Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 3 Dec 2024 20:41:40 +0100 Subject: [PATCH] Move gql to Language.GraphQL.TH --- CHANGELOG.md | 6 +++ graphql-spice.cabal | 4 +- src/Language/GraphQL/Class.hs | 1 + src/Language/GraphQL/TH.hs | 49 +++++++++++++++++++++ tests/Language/GraphQL/ClassSpec.hs | 13 +----- tests/Language/GraphQL/CoerceSpec.hs | 1 + tests/Language/GraphQL/DirectiveSpec.hs | 4 +- tests/Language/GraphQL/FragmentSpec.hs | 4 +- tests/Language/GraphQL/RootOperationSpec.hs | 4 +- tests/Language/GraphQL/THSpec.hs | 28 ++++++++++++ 10 files changed, 95 insertions(+), 19 deletions(-) create mode 100644 src/Language/GraphQL/TH.hs create mode 100644 tests/Language/GraphQL/THSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 2cd95ca..786efde 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,11 @@ The format is based on and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [Unreleased] +### Changed +- `Language.GraphQL.Class.gql` is moved to `Language.GraphQL.TH` where it was + before in `graphql`. + ## [1.0.5.0] - 2024-11-21 ### Added - Add `ToGraphQL` and `FromGraphQL` instances for `Value` and `HashMap`. @@ -41,6 +46,7 @@ and this project adheres to - JSON serialization. - Test helpers. +[Unreleased]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.5.0...master [1.0.5.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.4.0...v1.0.5.0 [1.0.4.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.3.0...v1.0.4.0 [1.0.3.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.2.0...v1.0.3.0 diff --git a/graphql-spice.cabal b/graphql-spice.cabal index 52caf30..750b38c 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -27,6 +27,7 @@ library Language.GraphQL.Class Language.GraphQL.JSON Language.GraphQL.Resolver + Language.GraphQL.TH Test.Hspec.GraphQL other-modules: hs-source-dirs: src @@ -38,7 +39,7 @@ library containers >= 0.6 && < 0.8, exceptions ^>= 0.10.4, hspec-expectations >= 0.8.2 && < 0.9, - graphql >= 1.3.0 && < 1.5.0, + graphql >= 1.3.0 && < 1.6.0, megaparsec >= 9.0 && < 10, scientific ^>= 0.3.7, template-haskell >= 2.16 && < 3, @@ -58,6 +59,7 @@ test-suite graphql-test Language.GraphQL.DirectiveSpec Language.GraphQL.FragmentSpec Language.GraphQL.RootOperationSpec + Language.GraphQL.THSpec hs-source-dirs: tests ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs index 6e8b080..67ae695 100644 --- a/src/Language/GraphQL/Class.hs +++ b/src/Language/GraphQL/Class.hs @@ -485,6 +485,7 @@ stripIndentation code = reverse -- | Removes leading and trailing newlines. Indentation of the first line is -- removed from each line of the string. +{-# DEPRECATED gql "Use Language.GraphQL.TH.gql instead" #-} gql :: QuasiQuoter gql = QuasiQuoter { quoteExp = pure . LitE . StringL . stripIndentation diff --git a/src/Language/GraphQL/TH.hs b/src/Language/GraphQL/TH.hs new file mode 100644 index 0000000..6e20586 --- /dev/null +++ b/src/Language/GraphQL/TH.hs @@ -0,0 +1,49 @@ +{- This Source Code Form is subject to the terms of the Mozilla Public License, + v. 2.0. If a copy of the MPL was not distributed with this file, You can + obtain one at https://mozilla.org/MPL/2.0/. -} + +module Language.GraphQL.TH + ( gql + ) where + +import Language.Haskell.TH + ( Exp(..) + , Lit(..) + ) +import Language.Haskell.TH.Quote (QuasiQuoter(..)) + +stripIndentation :: String -> String +stripIndentation code = reverse + $ dropWhile isLineBreak + $ reverse + $ unlines + $ indent spaces <$> lines' withoutLeadingNewlines + where + indent 0 xs = xs + indent count (' ' : xs) = indent (count - 1) xs + indent _ xs = xs + withoutLeadingNewlines = dropWhile isLineBreak code + spaces = length $ takeWhile (== ' ') withoutLeadingNewlines + lines' "" = [] + lines' string = + let (line, rest) = break isLineBreak string + reminder = + case rest of + [] -> [] + '\r' : '\n' : strippedString -> lines' strippedString + _ : strippedString -> lines' strippedString + in line : reminder + isLineBreak = flip any ['\n', '\r'] . (==) + +-- | Removes leading and trailing newlines. Indentation of the first line is +-- removed from each line of the string. +gql :: QuasiQuoter +gql = QuasiQuoter + { quoteExp = pure . LitE . StringL . stripIndentation + , quotePat = const + $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = const + $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = const + $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a declaration)" + } diff --git a/tests/Language/GraphQL/ClassSpec.hs b/tests/Language/GraphQL/ClassSpec.hs index 758b913..7744f10 100644 --- a/tests/Language/GraphQL/ClassSpec.hs +++ b/tests/Language/GraphQL/ClassSpec.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} + module Language.GraphQL.ClassSpec ( spec ) where @@ -18,7 +19,6 @@ import Language.GraphQL.Class , ToGraphQL(..) , deriveFromGraphQL , deriveToGraphQL - , gql ) import Test.Hspec (Spec, describe, it, shouldBe) import qualified Data.HashMap.Strict as HashMap @@ -161,14 +161,3 @@ spec = do let given = Type.Enum "TWO_FIELD_ENUM_2" expected = TWO_FIELD_ENUM_2 in fromGraphQL given `shouldBe` Just expected - - describe "gql" $ - it "replaces CRNL with NL" $ - let expected :: Text - expected = "line1\nline2\nline3" - actual = [gql| - line1 - line2 - line3 - |] - in actual `shouldBe` expected diff --git a/tests/Language/GraphQL/CoerceSpec.hs b/tests/Language/GraphQL/CoerceSpec.hs index 8bf11f1..86e1faf 100644 --- a/tests/Language/GraphQL/CoerceSpec.hs +++ b/tests/Language/GraphQL/CoerceSpec.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE OverloadedStrings #-} + module Language.GraphQL.CoerceSpec ( spec ) where diff --git a/tests/Language/GraphQL/DirectiveSpec.hs b/tests/Language/GraphQL/DirectiveSpec.hs index fd429a6..030fc79 100644 --- a/tests/Language/GraphQL/DirectiveSpec.hs +++ b/tests/Language/GraphQL/DirectiveSpec.hs @@ -14,11 +14,11 @@ import Language.GraphQL.AST.Document (Name) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Language.GraphQL as GraphQL -import Language.GraphQL.TH +import "graphql-spice" Language.GraphQL.TH import Language.GraphQL.Type import qualified Language.GraphQL.Type.Out as Out import Test.Hspec (Spec, describe, it) -import "graphql-spice" Test.Hspec.GraphQL +import Test.Hspec.GraphQL experimentalResolver :: Schema IO experimentalResolver = schema queryType Nothing Nothing mempty diff --git a/tests/Language/GraphQL/FragmentSpec.hs b/tests/Language/GraphQL/FragmentSpec.hs index a003f4c..18eb643 100644 --- a/tests/Language/GraphQL/FragmentSpec.hs +++ b/tests/Language/GraphQL/FragmentSpec.hs @@ -17,10 +17,10 @@ import Data.HashMap.Strict (HashMap) import Language.GraphQL.Type import Language.GraphQL.Error import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.TH +import "graphql-spice" Language.GraphQL.TH import qualified Language.GraphQL as GraphQL import Test.Hspec (Spec, describe, it) -import "graphql-spice" Test.Hspec.GraphQL +import Test.Hspec.GraphQL size :: (Text, Value) size = ("size", String "L") diff --git a/tests/Language/GraphQL/RootOperationSpec.hs b/tests/Language/GraphQL/RootOperationSpec.hs index e7fbcd7..8508c42 100644 --- a/tests/Language/GraphQL/RootOperationSpec.hs +++ b/tests/Language/GraphQL/RootOperationSpec.hs @@ -15,10 +15,10 @@ import qualified Data.HashMap.Strict as HashMap import Language.GraphQL import Language.GraphQL.AST (Name) import Test.Hspec (Spec, describe, it) -import Language.GraphQL.TH +import "graphql-spice" Language.GraphQL.TH import Language.GraphQL.Type import qualified Language.GraphQL.Type.Out as Out -import "graphql-spice" Test.Hspec.GraphQL +import Test.Hspec.GraphQL hatType :: Out.ObjectType IO hatType = Out.ObjectType "Hat" Nothing [] diff --git a/tests/Language/GraphQL/THSpec.hs b/tests/Language/GraphQL/THSpec.hs new file mode 100644 index 0000000..ffa6db6 --- /dev/null +++ b/tests/Language/GraphQL/THSpec.hs @@ -0,0 +1,28 @@ +{- This Source Code Form is subject to the terms of the Mozilla Public License, + v. 2.0. If a copy of the MPL was not distributed with this file, You can + obtain one at https://mozilla.org/MPL/2.0/. -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PackageImports #-} + +module Language.GraphQL.THSpec + ( spec + ) where + +import Data.Text (Text) +import "graphql-spice" Language.GraphQL.TH (gql) +import Test.Hspec (Spec, describe, it, shouldBe) + +spec :: Spec +spec = do + describe "gql" $ + it "replaces CRNL with NL" $ + let expected :: Text + expected = "line1\nline2\nline3" + actual = [gql| + line1 + line2 + line3 + |] + in actual `shouldBe` expected