Remove cariage return from the qq string

.gitea/deploy.awk

@@ -0,0 +1,3 @@
+END {
+    system("cabal upload --username belka --password "ENVIRON["HACKAGE_PASSWORD"]" "$0)
+}

.gitea/workflows/build.yml

@@ -2,67 +2,32 @@ name: Build
 
 on:
   push:
+    branches:
+      - '**'
   pull_request:
     branches: [master]
 
 jobs:
   audit:
-    runs-on: alpine
+    runs-on: buildenv
     steps:
-      - name: Set up environment
-        shell: ash {0}
-        run: |
-          apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
-      - name: Prepare system
-        run: |
-          curl --create-dirs --output-dir \
-            ~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
-          chmod +x ~/.ghcup/bin/ghcup
-          ~/.ghcup/bin/ghcup install ghc 9.4.8
-          ~/.ghcup/bin/ghcup install cabal 3.6.2.0
       - uses: actions/checkout@v4
-      - name: Install dependencies
+      - run: hlint -- src tests
-        run: |
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal install hlint --constraint="hlint ==3.6.1"
-      - run: ~/.cabal/bin/hlint -- src tests
 
   test:
-    runs-on: alpine
+    runs-on: buildenv
     steps:
-      - name: Set up environment
-        shell: ash {0}
-        run: |
-          apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
-      - name: Prepare system
-        run: |
-          curl --create-dirs --output-dir \
-            ~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
-          chmod +x ~/.ghcup/bin/ghcup
-          ~/.ghcup/bin/ghcup install ghc 9.4.8
-          ~/.ghcup/bin/ghcup install cabal 3.6.2.0
       - uses: actions/checkout@v4
       - name: Install dependencies
-        run: |
+        run: cabal update
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
+      - name: Prepare system
-          ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal build graphql-test
+        run: cabal build graphql-test
-      - run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal test --test-show-details=direct
+      - run: cabal test --test-show-details=streaming
 
   doc:
-    runs-on: alpine
+    runs-on: buildenv
     steps:
-      - name: Set up environment
-        shell: ash {0}
-        run: |
-          apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
-      - name: Prepare system
-        run: |
-          curl --create-dirs --output-dir \
-            ~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
-          chmod +x ~/.ghcup/bin/ghcup
-          ~/.ghcup/bin/ghcup install ghc 9.4.8
-          ~/.ghcup/bin/ghcup install cabal 3.6.2.0
       - uses: actions/checkout@v4
       - name: Install dependencies
-        run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
+        run: cabal update
-      - run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal haddock --enable-documentation
+      - run: cabal haddock --enable-documentation

.gitea/workflows/release.yml

@@ -0,0 +1,17 @@
+name: Release
+
+on:
+  push:
+    tags:
+      - '**'
+
+jobs:
+  release:
+    runs-on: buildenv
+    steps:
+      - uses: actions/checkout@v4
+      - name: Upload a candidate
+        env:
+          HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
+        run: |
+          cabal sdist | awk -f .gitea/deploy.awk

CHANGELOG.md

@@ -6,6 +6,11 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## [1.3.0.0] - 2024-05-01
+### Changed
+- Remove deprecated `runCollectErrs`, `Resolution`, `CollectErrsT` from the
+  `Error` module.
+
 ## [1.2.0.3] - 2024-01-09
 ### Fixed
 - Fix corrupted source distribution.
@@ -519,6 +524,7 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.
 
+[1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0
 [1.2.0.3]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.2...v1.2.0.3
 [1.2.0.2]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...v1.2.0.2
 [1.2.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.0...v1.2.0.1

graphql.cabal

@@ -1,7 +1,7 @@
 cabal-version: 2.4
 
 name:           graphql
-version:        1.2.0.3
+version:        1.3.0.0
 synopsis:       Haskell GraphQL implementation
 description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
 category:       Language
@@ -60,7 +60,7 @@ library
   build-depends:
     base >= 4.7 && < 5,
     conduit ^>= 1.3.4,
-    containers ^>= 0.6.2,
+    containers >= 0.6 && < 0.8,
     exceptions ^>= 0.10.4,
     megaparsec >= 9.0 && < 10,
     parser-combinators >= 1.3 && < 2,
@@ -85,6 +85,7 @@ test-suite graphql-test
     Language.GraphQL.Execute.CoerceSpec
     Language.GraphQL.Execute.OrderedMapSpec
     Language.GraphQL.ExecuteSpec
+    Language.GraphQL.THSpec
     Language.GraphQL.Type.OutSpec
     Language.GraphQL.Validate.RulesSpec
     Schemas.HeroSchema
@@ -93,7 +94,7 @@ test-suite graphql-test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
 
   build-depends:
-    QuickCheck ^>= 2.14.1,
+    QuickCheck >= 2.14 && < 2.16,
     base,
     conduit,
     exceptions,

src/Language/GraphQL/Error.hs

@@ -8,28 +8,22 @@
 
 -- | Error handling.
 module Language.GraphQL.Error
-    ( CollectErrsT
+    ( Error(..)
-    , Error(..)
     , Path(..)
-    , Resolution(..)
     , ResolverException(..)
     , Response(..)
     , ResponseEventStream
     , parseError
-    , runCollectErrs
     ) where
 
 import Conduit
 import Control.Exception (Exception(..))
-import Control.Monad.Trans.State (StateT, runStateT)
-import Data.HashMap.Strict (HashMap)
 import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Language.GraphQL.AST (Location(..), Name)
+import Language.GraphQL.AST (Location(..))
 import Language.GraphQL.Execute.Coerce
-import qualified Language.GraphQL.Type.Schema as Schema
 import Prelude hiding (null)
 import Text.Megaparsec
     ( ParseErrorBundle(..)
@@ -97,28 +91,3 @@ instance Show ResolverException where
     show (ResolverException e) = show e
 
 instance Exception ResolverException
-
--- * Deprecated
-
-{-# DEPRECATED runCollectErrs "runCollectErrs was part of the old executor and isn't used anymore" #-}
--- | Runs the given query computation, but collects the errors into an error
--- list, which is then sent back with the data.
-runCollectErrs :: (Monad m, Serialize a)
-    => HashMap Name (Schema.Type m)
-    -> CollectErrsT m a
-    -> m (Response a)
-runCollectErrs types' res = do
-    (dat, Resolution{..}) <- runStateT res
-        $ Resolution{ errors = Seq.empty, types = types' }
-    pure $ Response dat errors
-
-{-# DEPRECATED Resolution "Resolution was part of the old executor and isn't used anymore" #-}
--- | Executor context.
-data Resolution m = Resolution
-    { errors :: Seq Error
-    , types :: HashMap Name (Schema.Type m)
-    }
-
-{-# DEPRECATED CollectErrsT "CollectErrsT was part of the old executor and isn't used anymore" #-}
--- | A wrapper to pass error messages around.
-type CollectErrsT m = StateT (Resolution m) m

src/Language/GraphQL/TH.hs

@@ -12,17 +12,26 @@ import Language.Haskell.TH (Exp(..), Lit(..))
 
 stripIndentation :: String -> String
 stripIndentation code = reverse
-    $ dropNewlines
+    $ dropWhile isLineBreak
     $ reverse
     $ unlines
-    $ indent spaces <$> lines withoutLeadingNewlines
+    $ indent spaces <$> lines' withoutLeadingNewlines
   where
     indent 0 xs = xs
     indent count (' ' : xs) = indent (count - 1) xs
     indent _ xs = xs
-    withoutLeadingNewlines = dropNewlines code
+    withoutLeadingNewlines = dropWhile isLineBreak code
-    dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==)
     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.

tests/Language/GraphQL/AST/Arbitrary.hs

@@ -7,6 +7,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
 import Test.QuickCheck.Gen (Gen (..))
 import Data.Text (Text, pack)
+import Data.Functor ((<&>))
 
 newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
 
@@ -59,34 +60,36 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
         location' <- getAnyLocation <$> arbitrary
         pure $ AnyObjectField $ Doc.ObjectField name' value' location'
 
-newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } deriving (Eq, Show)
+newtype AnyValue = AnyValue { getAnyValue :: Doc.Value }
+    deriving (Eq, Show)
 
-instance Arbitrary AnyValue where
+instance Arbitrary AnyValue
-    arbitrary = AnyValue <$> oneof
+  where
+    arbitrary =
+        let variableGen :: Gen Doc.Value
+            variableGen = Doc.Variable . getAnyName <$> arbitrary
+            listGen :: Gen [Doc.Node Doc.Value]
+            listGen = (resize 5 . listOf) nodeGen
+            nodeGen :: Gen (Doc.Node Doc.Value)
+            nodeGen = fmap getAnyNode arbitrary <&> fmap getAnyValue
+            objectGen :: Gen [Doc.ObjectField Doc.Value]
+            objectGen = resize 1
+                $ fmap getNonEmpty arbitrary
+                <&> map (fmap getAnyValue . getAnyObjectField)
+         in AnyValue <$> oneof
             [ variableGen
             , Doc.Int <$> arbitrary
             , Doc.Float <$> arbitrary
-        , Doc.String <$> (getAnyPrintableText <$> arbitrary)
+            , Doc.String . getAnyPrintableText <$> arbitrary
             , Doc.Boolean <$> arbitrary
             , MkGen $ \_ _ -> Doc.Null
-        , Doc.Enum <$> (getAnyName <$> arbitrary)
+            , Doc.Enum . getAnyName <$> arbitrary
             , Doc.List <$> listGen
             , Doc.Object <$> objectGen
             ]
-            where
-                variableGen :: Gen Doc.Value
-                variableGen = Doc.Variable <$> (getAnyName <$> arbitrary)
-                listGen :: Gen [Doc.Node Doc.Value]
-                listGen = (resize 5 . listOf) nodeGen
-                nodeGen = do
-                    node' <- getAnyNode <$> (arbitrary :: Gen (AnyNode AnyValue))
-                    pure (getAnyValue <$> node')
-                objectGen :: Gen [Doc.ObjectField Doc.Value]
-                objectGen = resize 1 $ do
-                    list <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList (AnyObjectField AnyValue)))
-                    pure $ map (fmap getAnyValue . getAnyObjectField) list
 
-newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } deriving (Eq, Show)
+newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument }
+    deriving (Eq, Show)
 
 instance Arbitrary a => Arbitrary (AnyArgument a) where
     arbitrary = do

tests/Language/GraphQL/THSpec.hs

@@ -0,0 +1,23 @@
+{- 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 QuasiQuotes #-}
+
+module Language.GraphQL.THSpec
+    ( spec
+    ) where
+
+import Language.GraphQL.TH (gql)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec =
+    describe "gql" $
+        it "replaces CRNL with NL" $
+            let expected = "line1\nline2"
+                actual = [gql|
+                  line1
+                  line2
+                |]
+             in actual `shouldBe` expected