diff --git a/CHANGELOG.md b/CHANGELOG.md index 5eae607..bc44c57 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,10 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). ## [Unreleased] +### 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 diff --git a/graphql-spice.cabal b/graphql-spice.cabal index d69e11d..21e6a00 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -16,7 +16,7 @@ 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 diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs index df52d2b..938fcf0 100644 --- a/src/Language/GraphQL/Class.hs +++ b/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)" + } diff --git a/tests/Language/GraphQL/ClassSpec.hs b/tests/Language/GraphQL/ClassSpec.hs index 7e6c4cf..758b913 100644 --- a/tests/Language/GraphQL/ClassSpec.hs +++ b/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