{-# 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 = HistoryT m a -> m a
forall (m :: * -> *) a. HistoryT m a -> m a
startHistory (a -> a -> HistoryT m a
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 = ([a1] -> [a1]) -> m a2 -> m a2
forall a. ([a1] -> [a1]) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\[a1]
xs -> [a1]
xs [a1] -> [a1] -> [a1]
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 = HistoryT m a -> [Ref FieldName] -> m a
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 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
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 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
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 = [b] -> m (map k b)
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems ([b] -> m (map k b)) -> m [b] -> m (map k b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m b
f (t a -> [a]
forall a. t a -> [a]
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 = [(k, a)] -> m (map k a)
forall (m :: * -> *) (map :: * -> * -> *) k a.
(FromList m map k a, Monad m) =>
[(k, a)] -> m (map k a)
fromList ([(k, a)] -> m (map k a))
-> ([a] -> [(k, a)]) -> [a] -> m (map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall a b. (a -> b) -> [a] -> [b]
map a -> (k, a)
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 = SafeHashMap k a -> SafeHashMap k a -> m (SafeHashMap k a)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (k -> a -> SafeHashMap k a
forall a. k -> a -> SafeHashMap k a
forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton (a -> k
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 = [(k, a)] -> ResolutionT k a c m c
forall (m :: * -> *) k a coll.
(Monad m, Eq k, Hashable k) =>
[(k, a)] -> ResolutionT k a coll m coll
fromListT (a -> (k, a)
forall k a. KeyOf k a => a -> (k, a)
toPair (a -> (k, a)) -> [a] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
x [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
y))