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

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

import Control.Monad.Except (MonadError (throwError))
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,
  )

{-# DEPRECATED Failure "use MonadError" #-}

type Failure = MonadError

{-# DEPRECATED failure "use throwError" #-}
failure :: MonadError e m => e -> m a
failure :: e -> m a
failure = e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

(<:>) :: (Merge (HistoryT m) a, Monad m) => a -> a -> m a
a
x <:> :: 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 :: a1 -> m a2 -> m a2
addPath a1
p = ([a1] -> [a1]) -> m a2 -> m a2
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 :: 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 :: (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,
    Failure 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) -> 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)
traverse a -> m b
f (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 :: [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,
    Failure e m
  ) =>
  a ->
  SafeHashMap k a ->
  m (SafeHashMap k a)
insert :: 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 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 :: 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 (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 (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
y))