{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Internal.Utils
  ( IsMap (..),
    KeyOf (..),
    toPair,
    selectBy,
    traverseCollection,
    prop,
    fromLBS,
    toLBS,
    mergeT,
    Empty (..),
    HistoryT,
    addPath,
    startHistory,
    mergeConcat,
    (<:>),
    selectOr,
    insert,
    fromElems,
    throwErrors,
  )
where

import Control.Monad.Except (MonadError)
import Data.ByteString.Lazy (ByteString)
import Data.Mergeable
  ( IsMap (..),
    Merge (merge),
    NameCollision (..),
    ResolutionT,
    fromListT,
    mergeConcat,
    throwErrors,
  )
import Data.Mergeable.IsMap (FromList (..), selectBy, selectOr)
import Data.Mergeable.SafeHashMap (SafeHashMap)
import Data.Morpheus.Ext.Empty
import Data.Morpheus.Ext.KeyOf (KeyOf (..), toPair)
import Data.Morpheus.Types.Internal.AST.Base (Ref)
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( FieldName,
  )
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
import Instances.TH.Lift ()
import Relude hiding
  ( ByteString,
    decodeUtf8,
    encodeUtf8,
    fromList,
  )

(<:>) :: (Merge (HistoryT m) a, Monad m) => a -> a -> m a
a
x <:> :: forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> a
y = forall (m :: * -> *) a. HistoryT m a -> m a
startHistory (forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge a
x a
y)

addPath :: MonadReader [a1] m => a1 -> m a2 -> m a2
addPath :: forall a1 (m :: * -> *) a2.
MonadReader [a1] m =>
a1 -> m a2 -> m a2
addPath a1
p = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\[a1]
xs -> [a1]
xs forall a. Semigroup a => a -> a -> a
<> [a1
p])

type HistoryT = ReaderT [Ref FieldName]

startHistory :: HistoryT m a -> m a
startHistory :: forall (m :: * -> *) a. HistoryT m a -> m a
startHistory HistoryT m a
x = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HistoryT m a
x []

toLBS :: Text -> ByteString
toLBS :: Text -> ByteString
toLBS = Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict

fromLBS :: ByteString -> Text
fromLBS :: ByteString -> Text
fromLBS = Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8

prop :: (b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop :: forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop b -> b -> m b
f a -> b
fSel a
a1 a
a2 = b -> b -> m b
f (a -> b
fSel a
a1) (a -> b
fSel a
a2)

traverseCollection ::
  ( Monad m,
    MonadError GQLError m,
    KeyOf k b,
    FromList m map k b,
    Foldable t
  ) =>
  (a -> m b) ->
  t a ->
  m (map k b)
traverseCollection :: forall (m :: * -> *) k b (map :: * -> * -> *) (t :: * -> *) a.
(Monad m, MonadError GQLError m, KeyOf k b, FromList m map k b,
 Foldable t) =>
(a -> m b) -> t a -> m (map k b)
traverseCollection a -> m b
f t a
a = forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m b
f (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
a)

fromElems ::
  ( Monad m,
    KeyOf k a,
    FromList m map k a
  ) =>
  [a] ->
  m (map k a)
fromElems :: forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems = forall (m :: * -> *) (map :: * -> * -> *) k a.
(FromList m map k a, Monad m) =>
[(k, a)] -> m (map k a)
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall k a. KeyOf k a => a -> (k, a)
toPair

insert ::
  ( NameCollision e a,
    KeyOf k a,
    MonadError e m
  ) =>
  a ->
  SafeHashMap k a ->
  m (SafeHashMap k a)
insert :: forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, MonadError e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert a
x = forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton (forall k a. KeyOf k a => a -> k
keyOf a
x) a
x)

mergeT :: (KeyOf k a, Foldable t, Monad m) => t a -> t a -> ResolutionT k a c m c
mergeT :: forall k a (t :: * -> *) (m :: * -> *) c.
(KeyOf k a, Foldable t, Monad m) =>
t a -> t a -> ResolutionT k a c m c
mergeT t a
x t a
y = forall (m :: * -> *) k a coll.
(Monad m, Eq k, Hashable k) =>
[(k, a)] -> ResolutionT k a coll m coll
fromListT (forall k a. KeyOf k a => a -> (k, a)
toPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
y))