{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Utils.Types
  ( ConsRep (..),
    FieldRep (..),
    DataType (..),
    enumerate,
    isEmptyConstraint,
    fieldTypeName,
    isUnionRef,
    toFieldRes,
    unpackMonad,
  )
where

import Data.Morpheus.Types.Internal.AST
import qualified Data.Text as T
import Relude

data DataType (v :: Type) = DataType
  { forall v. DataType v -> TypeName
dataTypeName :: TypeName,
    forall v. DataType v -> Bool
tyIsUnion :: Bool,
    forall v. DataType v -> ConsRep v
tyCons :: ConsRep v
  }
  deriving (forall a b. a -> DataType b -> DataType a
forall a b. (a -> b) -> DataType a -> DataType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DataType b -> DataType a
$c<$ :: forall a b. a -> DataType b -> DataType a
fmap :: forall a b. (a -> b) -> DataType a -> DataType b
$cfmap :: forall a b. (a -> b) -> DataType a -> DataType b
Functor)

data ConsRep (v :: Type) = ConsRep
  { forall v. ConsRep v -> TypeName
consName :: TypeName,
    forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep v]
  }
  deriving (forall a b. a -> ConsRep b -> ConsRep a
forall a b. (a -> b) -> ConsRep a -> ConsRep b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ConsRep b -> ConsRep a
$c<$ :: forall a b. a -> ConsRep b -> ConsRep a
fmap :: forall a b. (a -> b) -> ConsRep a -> ConsRep b
$cfmap :: forall a b. (a -> b) -> ConsRep a -> ConsRep b
Functor)

data FieldRep (a :: Type) = FieldRep
  { forall a. FieldRep a -> FieldName
fieldSelector :: FieldName,
    forall a. FieldRep a -> TypeRef
fieldTypeRef :: TypeRef,
    forall a. FieldRep a -> a
fieldValue :: a
  }
  deriving (forall a b. a -> FieldRep b -> FieldRep a
forall a b. (a -> b) -> FieldRep a -> FieldRep b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FieldRep b -> FieldRep a
$c<$ :: forall a b. a -> FieldRep b -> FieldRep a
fmap :: forall a b. (a -> b) -> FieldRep a -> FieldRep b
$cfmap :: forall a b. (a -> b) -> FieldRep a -> FieldRep b
Functor)

-- setFieldNames ::  Power Int Text -> Power { _1 :: Int, _2 :: Text }
enumerate :: [FieldRep a] -> [FieldRep a]
enumerate :: forall a. [FieldRep a] -> [FieldRep a]
enumerate = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. Show a => a -> FieldRep a -> FieldRep a
setFieldName ([Int
0 ..] :: [Int])
  where
    setFieldName :: a -> FieldRep a -> FieldRep a
setFieldName a
i FieldRep a
field = FieldRep a
field {fieldSelector :: FieldName
fieldSelector = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ Text
"_" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall b a. (Show a, IsString b) => a -> b
show a
i)}

isEmptyConstraint :: ConsRep a -> Bool
isEmptyConstraint :: forall a. ConsRep a -> Bool
isEmptyConstraint ConsRep {consFields :: forall v. ConsRep v -> [FieldRep v]
consFields = []} = Bool
True
isEmptyConstraint ConsRep a
_ = Bool
False

fieldTypeName :: FieldRep k -> TypeName
fieldTypeName :: forall k. FieldRep k -> TypeName
fieldTypeName = TypeRef -> TypeName
typeConName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FieldRep a -> TypeRef
fieldTypeRef

isUnionRef :: TypeName -> ConsRep k -> Bool
isUnionRef :: forall k. TypeName -> ConsRep k -> Bool
isUnionRef TypeName
baseName ConsRep {TypeName
consName :: TypeName
consName :: forall v. ConsRep v -> TypeName
consName, consFields :: forall v. ConsRep v -> [FieldRep v]
consFields = [FieldRep k
fieldRep]} =
  TypeName
consName forall a. Eq a => a -> a -> Bool
== TypeName
baseName forall a. Semigroup a => a -> a -> a
<> forall k. FieldRep k -> TypeName
fieldTypeName FieldRep k
fieldRep
isUnionRef TypeName
_ ConsRep k
_ = Bool
False

toFieldRes :: FieldRep (m a) -> (FieldName, m a)
toFieldRes :: forall {k} (m :: k -> *) (a :: k).
FieldRep (m a) -> (FieldName, m a)
toFieldRes FieldRep {FieldName
fieldSelector :: FieldName
fieldSelector :: forall a. FieldRep a -> FieldName
fieldSelector, m a
fieldValue :: m a
fieldValue :: forall a. FieldRep a -> a
fieldValue} = (FieldName
fieldSelector, m a
fieldValue)

unpackMonad :: Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad :: forall (m :: * -> *) a. Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a. Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons

unpackMonadFromField :: Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField :: forall (m :: * -> *) a. Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField FieldRep {m a
TypeRef
FieldName
fieldValue :: m a
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
fieldValue :: forall a. FieldRep a -> a
fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldSelector :: forall a. FieldRep a -> FieldName
..} = do
  a
cont <- m a
fieldValue
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldRep {fieldValue :: a
fieldValue = a
cont, TypeRef
FieldName
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
..})

unpackMonadFromCons :: Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons :: forall (m :: * -> *) a. Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons ConsRep {[FieldRep (m a)]
TypeName
consFields :: [FieldRep (m a)]
consName :: TypeName
consFields :: forall v. ConsRep v -> [FieldRep v]
consName :: forall v. ConsRep v -> TypeName
..} = forall v. TypeName -> [FieldRep v] -> ConsRep v
ConsRep TypeName
consName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a. Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField [FieldRep (m a)]
consFields