{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    render,
    renderObject,
    renderMembers,
    newline,
    renderArguments,
    renderEntry,
    space,
    Rendering,
    fromText,
    intercalate,
    renderInputSeq,
  )
where

-- MORPHEUS

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 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) => [a] -> Rendering
renderMembers :: [a] -> Rendering
renderMembers [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 [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)