diff options
Diffstat (limited to 'src/Language/GraphQL/TH.hs')
| -rw-r--r-- | src/Language/GraphQL/TH.hs | 49 |
1 files changed, 49 insertions, 0 deletions
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)" + } |
