{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Rendering.RenderGQL
( RenderGQL (..),
render,
renderObject,
renderMembers,
newline,
renderArguments,
renderEntry,
space,
Rendering,
fromText,
intercalate,
renderInputSeq,
)
where
import qualified Data.Aeson as A
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Foldable (foldr')
import qualified Data.Text as T
import Relude hiding
( ByteString,
intercalate,
)
render :: RenderGQL a => a -> ByteString
render :: a -> ByteString
render a
x = Rendering -> Int -> ByteString
runRendering (a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL a
x) Int
0
newtype Rendering = Rendering
{ Rendering -> Int -> ByteString
runRendering :: Int -> ByteString
}
instance Semigroup Rendering where
Rendering Int -> ByteString
f <> :: Rendering -> Rendering -> Rendering
<> Rendering Int -> ByteString
g = (Int -> ByteString) -> Rendering
Rendering ((Int -> ByteString) -> Rendering)
-> (Int -> ByteString) -> Rendering
forall a b. (a -> b) -> a -> b
$ \Int
x -> Int -> ByteString
f Int
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
g Int
x
instance IsString Rendering where
fromString :: String -> Rendering
fromString = (Int -> ByteString) -> Rendering
Rendering ((Int -> ByteString) -> Rendering)
-> (String -> Int -> ByteString) -> String -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> ByteString
forall a b. a -> b -> a
const (ByteString -> Int -> ByteString)
-> (String -> ByteString) -> String -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
LB.pack
fromShow :: Show a => a -> Rendering
fromShow :: a -> Rendering
fromShow = String -> Rendering
forall a. IsString a => String -> a
fromString (String -> Rendering) -> (a -> String) -> a -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall b a. (Show a, IsString b) => a -> b
show
fromText :: Text -> Rendering
fromText :: Text -> Rendering
fromText = String -> Rendering
forall a. IsString a => String -> a
fromString (String -> Rendering) -> (Text -> String) -> Text -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
class RenderGQL a where
renderGQL :: a -> Rendering
instance
RenderGQL a =>
RenderGQL (Maybe a)
where
renderGQL :: Maybe a -> Rendering
renderGQL = Rendering -> (a -> Rendering) -> Maybe a -> Rendering
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rendering
"" a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL
instance (RenderGQL l, RenderGQL r) => RenderGQL (Either l r) where
renderGQL :: Either l r -> Rendering
renderGQL (Left l
x) = l -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL l
x
renderGQL (Right r
x) = r -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL r
x
instance RenderGQL ByteString where
renderGQL :: ByteString -> Rendering
renderGQL = (Int -> ByteString) -> Rendering
Rendering ((Int -> ByteString) -> Rendering)
-> (ByteString -> Int -> ByteString) -> ByteString -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> ByteString
forall a b. a -> b -> a
const
instance RenderGQL Int where
renderGQL :: Int -> Rendering
renderGQL = Int -> Rendering
forall a. Show a => a -> Rendering
fromShow
instance RenderGQL Float where
renderGQL :: Float -> Rendering
renderGQL = Float -> Rendering
forall a. Show a => a -> Rendering
fromShow
instance RenderGQL Double where
renderGQL :: Double -> Rendering
renderGQL = Double -> Rendering
forall a. Show a => a -> Rendering
fromShow
instance RenderGQL Text where
renderGQL :: Text -> Rendering
renderGQL = Text -> Rendering
forall a. Show a => a -> Rendering
fromShow
instance RenderGQL Bool where
renderGQL :: Bool -> Rendering
renderGQL Bool
True = Rendering
"true"
renderGQL Bool
False = Rendering
"false"
instance RenderGQL A.Value where
renderGQL :: Value -> Rendering
renderGQL = ByteString -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (ByteString -> Rendering)
-> (Value -> ByteString) -> Value -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode
space :: Rendering
space :: Rendering
space = Rendering
" "
newline :: Rendering
newline :: Rendering
newline = Rendering
"\n" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> (Int -> ByteString) -> Rendering
Rendering Int -> ByteString
forall a. (Semigroup a, IsString a) => Int -> a
indentionSize
indentionSize :: (Semigroup a, IsString a) => Int -> a
indentionSize :: Int -> a
indentionSize Int
0 = a
""
indentionSize Int
n = Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) a
" "
indent :: Rendering -> Rendering
indent :: Rendering -> Rendering
indent (Rendering Int -> ByteString
f) = (Int -> ByteString) -> Rendering
Rendering ((Int -> ByteString) -> Rendering)
-> (Int -> ByteString) -> Rendering
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
f (Int -> ByteString) -> (Int -> Int) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
intercalate :: Rendering -> [Rendering] -> Rendering
intercalate :: Rendering -> [Rendering] -> Rendering
intercalate (Rendering Int -> ByteString
f) [Rendering]
fs = (Int -> ByteString) -> Rendering
Rendering ((Int -> ByteString) -> Rendering)
-> (Int -> ByteString) -> Rendering
forall a b. (a -> b) -> a -> b
$ \Int
x -> ByteString -> [ByteString] -> ByteString
LB.intercalate (Int -> ByteString
f Int
x) ((Rendering -> ByteString) -> [Rendering] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
x Int -> (Int -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
&) ((Int -> ByteString) -> ByteString)
-> (Rendering -> Int -> ByteString) -> Rendering -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rendering -> Int -> ByteString
runRendering) [Rendering]
fs)
indentNewline :: Rendering -> Rendering
indentNewline :: Rendering -> Rendering
indentNewline Rendering
rendering = Rendering -> Rendering
indent (Rendering
newline Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
rendering)
renderAtNewLine :: (RenderGQL a) => [a] -> Rendering
renderAtNewLine :: [a] -> Rendering
renderAtNewLine [a]
elems = Rendering -> Rendering
indentNewline (Rendering -> Rendering) -> Rendering -> Rendering
forall a b. (a -> b) -> a -> b
$ Rendering -> [Rendering] -> Rendering
intercalate Rendering
newline ((a -> Rendering) -> [a] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL [a]
elems)
renderObject :: (RenderGQL a) => [a] -> Rendering
renderObject :: [a] -> Rendering
renderObject [a]
fields = Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"{" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [a] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderAtNewLine [a]
fields Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"}"
renderMembers :: (RenderGQL a, Foldable t) => t a -> Rendering
renderMembers :: t a -> Rendering
renderMembers t a
members = Rendering -> [Rendering] -> Rendering
intercalate (Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"|" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
space) ((a -> Rendering) -> [a] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
members))
renderArguments :: (RenderGQL a) => [a] -> Rendering
renderArguments :: [a] -> Rendering
renderArguments [a]
arguments
| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
arguments = Rendering
""
| Bool
otherwise = Rendering
"(" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering -> [Rendering] -> Rendering
intercalate Rendering
", " (a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (a -> Rendering) -> [a] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
arguments) Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
")"
renderEntry ::
(RenderGQL name, RenderGQL value) =>
name ->
value ->
Rendering
renderEntry :: name -> value -> Rendering
renderEntry name
name value
value = name -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL name
name Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
": " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> value -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL value
value
renderInputSeq ::
(Foldable t, RenderGQL a) =>
t a ->
Rendering
renderInputSeq :: t a -> Rendering
renderInputSeq = Rendering -> Maybe Rendering -> Rendering
forall a. a -> Maybe a -> a
fromMaybe Rendering
"" (Maybe Rendering -> Rendering)
-> (t a -> Maybe Rendering) -> t a -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe Rendering -> Maybe Rendering)
-> Maybe Rendering -> t a -> Maybe Rendering
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> Maybe Rendering -> Maybe Rendering
forall a. RenderGQL a => a -> Maybe Rendering -> Maybe Rendering
renderValue Maybe Rendering
forall a. Maybe a
Nothing
where
renderValue :: RenderGQL a => a -> Maybe Rendering -> Maybe Rendering
renderValue :: a -> Maybe Rendering -> Maybe Rendering
renderValue a
value Maybe Rendering
Nothing = Rendering -> Maybe Rendering
forall a. a -> Maybe a
Just (a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL a
value)
renderValue a
value (Just Rendering
txt) = Rendering -> Maybe Rendering
forall a. a -> Maybe a
Just (a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL a
value Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
", " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
txt)