{- 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/. -}

-- | Template Haskell helpers.
module Language.GraphQL.TH
    ( gql
    ) where

import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.TH (Exp(..), Lit(..))

stripIndentation :: String -> String
stripIndentation :: String -> String
stripIndentation String
code = String -> String
forall a. [a] -> [a]
reverse
    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
dropNewlines
    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse
    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall t. (Eq t, Num t) => t -> String -> String
indent Int
spaces (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
withoutLeadingNewlines
  where
    indent :: t -> String -> String
indent t
0 String
xs = String
xs
    indent t
count (Char
' ' : String
xs) = t -> String -> String
indent (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) String
xs
    indent t
_ String
xs = String
xs
    withoutLeadingNewlines :: String
withoutLeadingNewlines = String -> String
dropNewlines String
code
    dropNewlines :: String -> String
dropNewlines = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
    spaces :: Int
spaces = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
withoutLeadingNewlines

-- | Removes leading and trailing newlines. Indentation of the first line is
-- removed from each line of the string.
gql :: QuasiQuoter
gql :: QuasiQuoter
gql = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> (String -> Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (String -> String) -> String -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripIndentation
    , quotePat :: String -> Q Pat
quotePat = Q Pat -> String -> Q Pat
forall a b. a -> b -> a
const
        (Q Pat -> String -> Q Pat) -> Q Pat -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal gql QuasiQuote (allowed as expression only, used as a pattern)"
    , quoteType :: String -> Q Type
quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const
        (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal gql QuasiQuote (allowed as expression only, used as a type)"
    , quoteDec :: String -> Q [Dec]
quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const
        (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Illegal gql QuasiQuote (allowed as expression only, used as a declaration)"
    }