{-# 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 :: forall a. RenderGQL a => a -> ByteString
render a
x = Rendering -> Int -> ByteString
runRendering (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 forall a b. (a -> b) -> a -> b
$ \Int
x -> Int -> ByteString
f Int
x forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
g Int
x

instance IsString Rendering where
  fromString :: String -> Rendering
fromString = (Int -> ByteString) -> Rendering
Rendering forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
LB.pack

fromShow :: Show a => a -> Rendering
fromShow :: forall a. Show a => a -> Rendering
fromShow = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show

fromText :: Text -> Rendering
fromText :: Text -> Rendering
fromText = forall a. IsString a => String -> a
fromString 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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) = forall a. RenderGQL a => a -> Rendering
renderGQL l
x
  renderGQL (Right r
x) = forall a. RenderGQL a => a -> Rendering
renderGQL r
x

instance RenderGQL ByteString where
  renderGQL :: ByteString -> Rendering
renderGQL = (Int -> ByteString) -> Rendering
Rendering forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance RenderGQL Int where
  renderGQL :: Int -> Rendering
renderGQL = forall a. Show a => a -> Rendering
fromShow

instance RenderGQL Float where
  renderGQL :: Float -> Rendering
renderGQL = forall a. Show a => a -> Rendering
fromShow

instance RenderGQL Double where
  renderGQL :: Double -> Rendering
renderGQL = forall a. Show a => a -> Rendering
fromShow

instance RenderGQL Text where
  renderGQL :: Text -> Rendering
renderGQL = 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 = forall a. RenderGQL a => a -> Rendering
renderGQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
A.encode

space :: Rendering
space :: Rendering
space = Rendering
" "

newline :: Rendering
newline :: Rendering
newline = Rendering
"\n" forall a. Semigroup a => a -> a -> a
<> (Int -> ByteString) -> Rendering
Rendering forall a. (Semigroup a, IsString a) => Int -> a
indentionSize

indentionSize :: (Semigroup a, IsString a) => Int -> a
indentionSize :: forall a. (Semigroup a, IsString a) => Int -> a
indentionSize Int
0 = a
""
indentionSize Int
n = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
n 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 forall a b. (a -> b) -> a -> b
$ Int -> ByteString
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 forall a b. (a -> b) -> a -> b
$ \Int
x -> ByteString -> [ByteString] -> ByteString
LB.intercalate (Int -> ByteString
f Int
x) (forall a b. (a -> b) -> [a] -> [b]
map ((Int
x forall a b. a -> (a -> b) -> b
&) 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 forall a. Semigroup a => a -> a -> a
<> Rendering
rendering)

renderAtNewLine :: (RenderGQL a) => [a] -> Rendering
renderAtNewLine :: forall a. RenderGQL a => [a] -> Rendering
renderAtNewLine [a]
elems = Rendering -> Rendering
indentNewline forall a b. (a -> b) -> a -> b
$ Rendering -> [Rendering] -> Rendering
intercalate Rendering
newline (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. RenderGQL a => a -> Rendering
renderGQL [a]
elems)

renderObject :: (RenderGQL a) => [a] -> Rendering
renderObject :: forall a. RenderGQL a => [a] -> Rendering
renderObject [a]
fields = Rendering
space forall a. Semigroup a => a -> a -> a
<> Rendering
"{" forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => [a] -> Rendering
renderAtNewLine [a]
fields forall a. Semigroup a => a -> a -> a
<> Rendering
newline forall a. Semigroup a => a -> a -> a
<> Rendering
"}"

renderMembers :: (RenderGQL a, Foldable t) => t a -> Rendering
renderMembers :: forall a (t :: * -> *).
(RenderGQL a, Foldable t) =>
t a -> Rendering
renderMembers t a
members = Rendering -> [Rendering] -> Rendering
intercalate (Rendering
space forall a. Semigroup a => a -> a -> a
<> Rendering
"|" forall a. Semigroup a => a -> a -> a
<> Rendering
space) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. RenderGQL a => a -> Rendering
renderGQL (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
members))

renderArguments :: (RenderGQL a) => [a] -> Rendering
renderArguments :: forall a. RenderGQL a => [a] -> Rendering
renderArguments [a]
arguments
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
arguments = Rendering
""
  | Bool
otherwise = Rendering
"(" forall a. Semigroup a => a -> a -> a
<> Rendering -> [Rendering] -> Rendering
intercalate Rendering
", " (forall a. RenderGQL a => a -> Rendering
renderGQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
arguments) forall a. Semigroup a => a -> a -> a
<> Rendering
")"

renderEntry ::
  (RenderGQL name, RenderGQL value) =>
  name ->
  value ->
  Rendering
renderEntry :: forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry name
name value
value = forall a. RenderGQL a => a -> Rendering
renderGQL name
name forall a. Semigroup a => a -> a -> a
<> Rendering
": " forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL value
value

renderInputSeq ::
  (Foldable t, RenderGQL a) =>
  t a ->
  Rendering
renderInputSeq :: forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq = forall a. a -> Maybe a -> a
fromMaybe Rendering
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' forall a. RenderGQL a => a -> Maybe Rendering -> Maybe Rendering
renderValue forall a. Maybe a
Nothing
  where
    renderValue :: RenderGQL a => a -> Maybe Rendering -> Maybe Rendering
    renderValue :: forall a. RenderGQL a => a -> Maybe Rendering -> Maybe Rendering
renderValue a
value Maybe Rendering
Nothing = forall a. a -> Maybe a
Just (forall a. RenderGQL a => a -> Rendering
renderGQL a
value)
    renderValue a
value (Just Rendering
txt) = forall a. a -> Maybe a
Just (forall a. RenderGQL a => a -> Rendering
renderGQL a
value forall a. Semigroup a => a -> a -> a
<> Rendering
", " forall a. Semigroup a => a -> a -> a
<> Rendering
txt)