module Domain.Resolvers.TypeCentricDoc
where

import Domain.Prelude hiding (lookup)
import DomainCore.Model
import qualified Domain.Models.TypeCentricDoc as Doc
import qualified Domain.Models.TypeString as TypeString
import qualified Data.Text as Text
import qualified Domain.Text as Text


eliminateDoc :: Applicative f => Doc.Doc -> f [TypeDec]
eliminateDoc :: forall (f :: * -> *). Applicative f => Doc -> f [TypeDec]
eliminateDoc =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> Structure -> f [TypeDec]
structureTypeDecs [])) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

structureTypeDecs :: Applicative f => [Text] -> Text -> Doc.Structure -> f [TypeDec]
structureTypeDecs :: forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> Structure -> f [TypeDec]
structureTypeDecs [Text]
namespace Text
name Structure
structure =
  (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f TypeDec
primary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *).
Applicative f =>
[Text] -> Structure -> f [TypeDec]
structureGeneratedTypeDecs [Text]
nextNamespace Structure
structure
  where
    primary :: f TypeDec
primary =
      Text -> TypeDef -> TypeDec
TypeDec Text
renderedName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
Applicative f =>
[Text] -> Structure -> f TypeDef
structureTypeDef [Text]
nextNamespace Structure
structure
      where
        renderedName :: Text
renderedName =
          [Text] -> Text
Text.concat (forall a. [a] -> [a]
reverse [Text]
nextNamespace)
    nextNamespace :: [Text]
nextNamespace =
      Text
name forall a. a -> [a] -> [a]
: [Text]
namespace

structureGeneratedTypeDecs :: Applicative f => [Text] -> Doc.Structure -> f [TypeDec]
structureGeneratedTypeDecs :: forall (f :: * -> *).
Applicative f =>
[Text] -> Structure -> f [TypeDec]
structureGeneratedTypeDecs [Text]
namespace =
  \ case
    Doc.ProductStructure [(Text, NestedTypeExpression)]
structure ->
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall {f :: * -> *}.
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f [TypeDec]
nestedTypeExpressionTypeDecs [Text]
namespace forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
Text.ucFirst)) [(Text, NestedTypeExpression)]
structure
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    Doc.SumStructure [(Text, [NestedTypeExpression])]
structure ->
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Text
a, [NestedTypeExpression]
b) -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {f :: * -> *}.
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f [TypeDec]
nestedTypeExpressionTypeDecs [Text]
namespace (Text -> Text
Text.ucFirst Text
a)) [NestedTypeExpression]
b) [(Text, [NestedTypeExpression])]
structure
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)
    Structure
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure []

nestedTypeExpressionTypeDecs :: [Text] -> Text -> NestedTypeExpression -> f [TypeDec]
nestedTypeExpressionTypeDecs [Text]
namespace Text
name =
  \ case
    Doc.StructureNestedTypeExpression Structure
a ->
      forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> Structure -> f [TypeDec]
structureTypeDecs [Text]
namespace Text
name Structure
a
    NestedTypeExpression
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure []

structureTypeDef :: Applicative f => [Text] -> Doc.Structure -> f TypeDef
structureTypeDef :: forall (f :: * -> *).
Applicative f =>
[Text] -> Structure -> f TypeDef
structureTypeDef [Text]
namespace =
  \ case
    Doc.ProductStructure [(Text, NestedTypeExpression)]
structure ->
      [(Text, Type)] -> TypeDef
ProductTypeDef 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 a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f (Text, Type)
eliminateProductStructureUnit [Text]
namespace)) [(Text, NestedTypeExpression)]
structure
    Doc.SumStructure [(Text, [NestedTypeExpression])]
structure ->
      [(Text, [Type])] -> TypeDef
SumTypeDef 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 a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> [NestedTypeExpression] -> f (Text, [Type])
eliminateSumStructureUnit [Text]
namespace)) [(Text, [NestedTypeExpression])]
structure
    Doc.EnumStructure [Text]
variants ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, [Type])] -> TypeDef
SumTypeDef (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[]) [Text]
variants))

eliminateProductStructureUnit :: Applicative f => [Text] -> Text -> Doc.NestedTypeExpression -> f (Text, Type)
eliminateProductStructureUnit :: forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f (Text, Type)
eliminateProductStructureUnit [Text]
namespace Text
name NestedTypeExpression
productTypeExpression =
  (,) Text
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f Type
nestedTypeExpressionType [Text]
namespace Text
name NestedTypeExpression
productTypeExpression

eliminateSumStructureUnit :: Applicative f => [Text] -> Text -> [Doc.NestedTypeExpression] -> f (Text, [Type])
eliminateSumStructureUnit :: forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> [NestedTypeExpression] -> f (Text, [Type])
eliminateSumStructureUnit [Text]
namespace Text
name [NestedTypeExpression]
sumTypeExpression =
  (,) Text
name 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 (f :: * -> *).
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f Type
nestedTypeExpressionType [Text]
namespace Text
name) [NestedTypeExpression]
sumTypeExpression

nestedTypeExpressionType :: Applicative f => [Text] -> Text -> Doc.NestedTypeExpression -> f Type
nestedTypeExpressionType :: forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> NestedTypeExpression -> f Type
nestedTypeExpressionType [Text]
namespace Text
name =
  \ case
    Doc.AppSeqNestedTypeExpression AppSeq
a ->
      NonEmpty Type -> Type
AppType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq AppSeq
a
    Doc.StructureNestedTypeExpression Structure
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Type
RefType ([Text] -> Text
Text.concat (forall a. [a] -> [a]
reverse (Text -> Text
Text.ucFirst Text
name forall a. a -> [a] -> [a]
: [Text]
namespace))))

eliminateTypeStringCommaSeq :: t AppSeq -> f (t (NonEmpty Type))
eliminateTypeStringCommaSeq =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq

eliminateTypeStringAppSeq :: Applicative f => NonEmpty TypeString.Unit -> f (NonEmpty Type)
eliminateTypeStringAppSeq :: forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {f :: * -> *}. Applicative f => Unit -> f Type
eliminateTypeStringUnit

eliminateTypeStringUnit :: Unit -> f Type
eliminateTypeStringUnit =
  \ case
    TypeString.InSquareBracketsUnit AppSeq
appSeq ->
      forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq AppSeq
appSeq forall a b. a -> (a -> b) -> b
&
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> Type
ListType forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty Type -> Type
AppType)
    TypeString.InParensUnit CommaSeq
commaSeq ->
      forall {t :: * -> *} {f :: * -> *}.
(Traversable t, Applicative f) =>
t AppSeq -> f (t (NonEmpty Type))
eliminateTypeStringCommaSeq CommaSeq
commaSeq forall a b. a -> (a -> b) -> b
&
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Type] -> Type
tupleIfNotOne forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Type -> Type
AppType)
      where
        tupleIfNotOne :: [Type] -> Type
tupleIfNotOne =
          \ case
            [Type
a] -> Type
a
            [Type]
a -> [Type] -> Type
TupleType [Type]
a
    TypeString.RefUnit NonEmpty Text
typeRef ->
      forall {a} {f :: * -> *}.
(Item a ~ Text, Applicative f, IsList a) =>
a -> f Text
eliminateTypeRef NonEmpty Text
typeRef forall a b. a -> (a -> b) -> b
&
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Type
RefType

eliminateTypeRef :: a -> f Text
eliminateTypeRef =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text] -> Text
Text.intercalate Text
"." forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall l. IsList l => l -> [Item l]
toList