Release 1.0.4.0

.gitea/deploy.awk

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

.gitea/workflows/build.yml

@@ -2,6 +2,8 @@ name: Build
 
 on:
   push:
+    branches:
+      - '**'
   pull_request:
     branches: [master]
 

.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,12 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## [1.0.4.0] - 2024-10-24
+### Added
+- `gql` quasi quoter which generates a string literal with the first line
+  starting at the first column and all following lines indented relative to the
+  first line.
+
 ## [1.0.3.0] - 2024-07-20
 ### Added
 - Add `deriveToGraphQL` for deriving `ToGraphQL` instances automatically.
@@ -31,6 +37,7 @@ and this project adheres to
 - JSON serialization.
 - Test helpers.
 
+[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
 [1.0.2.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.1.0...v1.0.2.0
 [1.0.1.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.0.0...v1.0.1.0

graphql-spice.cabal

@@ -1,7 +1,7 @@
-cabal-version:      2.4
+cabal-version:      3.0
 
 name:               graphql-spice
-version:            1.0.3.0
+version:            1.0.4.0
 synopsis:           GraphQL with batteries
 description:        Various extensions and convenience functions for the core
                     graphql package.
@@ -10,13 +10,13 @@ homepage:           https://git.caraus.tech/OSS/graphql-spice
 bug-reports:        https://git.caraus.tech/OSS/graphql-spice/issues
 author:             Eugen Wissner <belka@caraus.de>
 maintainer:         belka@caraus.de
-copyright:          (c) 2021-2023 Eugen Wissner
+copyright:          (c) 2021-2024 Eugen Wissner
 license:            MPL-2.0
 license-files:      LICENSE
 build-type:         Simple
 extra-source-files: CHANGELOG.md
 tested-with:
-  GHC == 9.4.8
+  GHC == 9.8.2
 
 source-repository head
   type: git
@@ -35,15 +35,15 @@ library
       aeson >= 2.0.3 && < 2.3,
       base >= 4.7 && < 5,
       conduit ^>= 1.3.4,
-      containers ^>= 0.6.2,
+      containers >= 0.6 && < 0.8,
       exceptions ^>= 0.10.4,
       hspec-expectations >= 0.8.2 && < 0.9,
-      graphql >= 1.2,
+      graphql ^>= 1.3.0,
       megaparsec >= 9.0 && < 10,
       scientific ^>= 0.3.7,
       template-haskell >= 2.16 && < 3,
       text >= 1.2 && < 3,
-      time >= 1.11.1,
+      time >= 1.12.2 && < 1.15,
       transformers >= 0.5.6 && < 0.7,
       vector >= 0.12 && < 0.14,
       unordered-containers ^>= 0.2.16

src/Language/GraphQL/Class.hs

@@ -13,6 +13,7 @@ module Language.GraphQL.Class
     , ToGraphQL(..)
     , deriveFromGraphQL
     , deriveToGraphQL
+    , gql
     ) where
 
 import Data.Int (Int8, Int16, Int32, Int64)
@@ -45,6 +46,7 @@ import Language.Haskell.TH
     , Dec(..)
     , Exp(..)
     , Info(..)
+    , Lit(..)
     , Quote(..)
     , Name
     , Q
@@ -72,6 +74,7 @@ import Language.Haskell.TH
     , litP
     , wildP
     )
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
 import Data.Foldable (Foldable(..))
 import qualified Data.HashMap.Strict as HashMap
 import qualified Language.GraphQL.Type as Type
@@ -438,3 +441,39 @@ deriveToGraphQL typeName = do
         [ litE (stringL $ nameBase name')
         , [|toGraphQL $(varE alias)|]
         ]
+
+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)"
+    }

tests/Language/GraphQL/ClassSpec.hs

@@ -3,6 +3,7 @@
    obtain one at https://mozilla.org/MPL/2.0/. -}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Language.GraphQL.ClassSpec
     ( spec
@@ -17,6 +18,7 @@ import Language.GraphQL.Class
     , ToGraphQL(..)
     , deriveFromGraphQL
     , deriveToGraphQL
+    , gql
     )
 import Test.Hspec (Spec, describe, it, shouldBe)
 import qualified Data.HashMap.Strict as HashMap
@@ -159,3 +161,14 @@ 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