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

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

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

structureTypeDef :: Applicative f => [Text] -> Doc.Structure -> f TypeDef
structureTypeDef :: [Text] -> Structure -> f TypeDef
structureTypeDef [Text]
namespace =
  \ case
    Doc.ProductStructure [(Text, NestedTypeExpression)]
structure ->
      [(Text, Type)] -> TypeDef
ProductTypeDef ([(Text, Type)] -> TypeDef) -> f [(Text, Type)] -> f TypeDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, NestedTypeExpression) -> f (Text, Type))
-> [(Text, NestedTypeExpression)] -> f [(Text, Type)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> NestedTypeExpression -> f (Text, Type))
-> (Text, NestedTypeExpression) -> f (Text, Type)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Text] -> Text -> NestedTypeExpression -> f (Text, Type)
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 ([(Text, [Type])] -> TypeDef) -> f [(Text, [Type])] -> f TypeDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, [NestedTypeExpression]) -> f (Text, [Type]))
-> [(Text, [NestedTypeExpression])] -> f [(Text, [Type])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> [NestedTypeExpression] -> f (Text, [Type]))
-> (Text, [NestedTypeExpression]) -> f (Text, [Type])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Text] -> Text -> [NestedTypeExpression] -> f (Text, [Type])
forall (f :: * -> *).
Applicative f =>
[Text] -> Text -> [NestedTypeExpression] -> f (Text, [Type])
eliminateSumStructureUnit [Text]
namespace)) [(Text, [NestedTypeExpression])]
structure
    Doc.EnumStructure [Text]
variants ->
      TypeDef -> f TypeDef
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, [Type])] -> TypeDef
SumTypeDef ((Text -> (Text, [Type])) -> [Text] -> [(Text, [Type])]
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 :: [Text] -> Text -> NestedTypeExpression -> f (Text, Type)
eliminateProductStructureUnit [Text]
namespace Text
name NestedTypeExpression
productTypeExpression =
  (,) Text
name (Type -> (Text, Type)) -> f Type -> f (Text, Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Text -> NestedTypeExpression -> f Type
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 :: [Text] -> Text -> [NestedTypeExpression] -> f (Text, [Type])
eliminateSumStructureUnit [Text]
namespace Text
name [NestedTypeExpression]
sumTypeExpression =
  (,) Text
name ([Type] -> (Text, [Type])) -> f [Type] -> f (Text, [Type])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NestedTypeExpression -> f Type)
-> [NestedTypeExpression] -> f [Type]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text] -> Text -> NestedTypeExpression -> f Type
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 :: [Text] -> Text -> NestedTypeExpression -> f Type
nestedTypeExpressionType [Text]
namespace Text
name =
  \ case
    Doc.AppSeqNestedTypeExpression AppSeq
a ->
      NonEmpty Type -> Type
AppType (NonEmpty Type -> Type) -> f (NonEmpty Type) -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppSeq -> f (NonEmpty Type)
forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq AppSeq
a
    Doc.StructureNestedTypeExpression Structure
_ ->
      Type -> f Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Type
RefType ([Text] -> Text
Text.concat ([Text] -> [Text]
forall a. [a] -> [a]
reverse (Text -> Text
Text.ucFirst Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
namespace))))

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

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

eliminateTypeStringUnit :: Unit -> f Type
eliminateTypeStringUnit =
  \ case
    TypeString.InSquareBracketsUnit AppSeq
appSeq ->
      AppSeq -> f (NonEmpty Type)
forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq AppSeq
appSeq f (NonEmpty Type) -> (f (NonEmpty Type) -> f Type) -> f Type
forall a b. a -> (a -> b) -> b
&
        (NonEmpty Type -> Type) -> f (NonEmpty Type) -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> Type
ListType (Type -> Type) -> (NonEmpty Type -> Type) -> NonEmpty Type -> Type
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 ->
      CommaSeq -> f [NonEmpty Type]
forall (t :: * -> *) (f :: * -> *).
(Traversable t, Applicative f) =>
t AppSeq -> f (t (NonEmpty Type))
eliminateTypeStringCommaSeq CommaSeq
commaSeq f [NonEmpty Type] -> (f [NonEmpty Type] -> f Type) -> f Type
forall a b. a -> (a -> b) -> b
&
        ([NonEmpty Type] -> Type) -> f [NonEmpty Type] -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Type] -> Type
tupleIfNotOne ([Type] -> Type)
-> ([NonEmpty Type] -> [Type]) -> [NonEmpty Type] -> Type
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) -> [NonEmpty Type] -> [Type]
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 ->
      NonEmpty Text -> f Text
forall (f :: * -> *) a.
(Applicative f, IsList a, Item a ~ Text) =>
a -> f Text
eliminateTypeRef NonEmpty Text
typeRef f Text -> (f Text -> f Type) -> f Type
forall a b. a -> (a -> b) -> b
&
        (Text -> Type) -> f Text -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Type
RefType

eliminateTypeRef :: a -> f Text
eliminateTypeRef =
  Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> f Text) -> (a -> Text) -> a -> f Text
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
"." ([Text] -> Text) -> (a -> [Text]) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> [Text]
forall l. IsList l => l -> [Item l]
toList