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


eliminateDoc :: t (Text, Structure) -> f (t TypeDec)
eliminateDoc =
  ((Text, Structure) -> f TypeDec)
-> t (Text, Structure) -> f (t TypeDec)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Structure) -> f TypeDec
forall (f :: * -> *).
Applicative f =>
(Text, Structure) -> f TypeDec
eliminateNameAndStructure

eliminateNameAndStructure :: (Text, Structure) -> f TypeDec
eliminateNameAndStructure (Text
name, Structure
structure) =
  Text -> TypeDef -> TypeDec
TypeDec Text
name (TypeDef -> TypeDec) -> f TypeDef -> f TypeDec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Structure -> f TypeDef
forall (f :: * -> *). Applicative f => Structure -> f TypeDef
eliminateStructure Structure
structure

eliminateStructure :: Structure -> f TypeDef
eliminateStructure =
  \ case
    Doc.ProductStructure [(Text, AppSeq)]
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, AppSeq) -> f (Text, Type))
-> [(Text, AppSeq)] -> f [(Text, Type)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, AppSeq) -> f (Text, Type)
forall (f :: * -> *) a. Applicative f => (a, AppSeq) -> f (a, Type)
eliminateProductStructureUnit [(Text, AppSeq)]
structure
    Doc.SumStructure [(Text, SumTypeExpression)]
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, SumTypeExpression) -> f (Text, [Type]))
-> [(Text, SumTypeExpression)] -> f [(Text, [Type])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, SumTypeExpression) -> f (Text, [Type])
forall (f :: * -> *) a.
Applicative f =>
(a, SumTypeExpression) -> f (a, [Type])
eliminateSumStructureUnit [(Text, SumTypeExpression)]
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 :: (a, AppSeq) -> f (a, Type)
eliminateProductStructureUnit (a
name, AppSeq
appSeq) =
  (,) a
name (Type -> (a, Type))
-> (NonEmpty Type -> Type) -> NonEmpty Type -> (a, 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 (NonEmpty Type -> (a, Type)) -> f (NonEmpty Type) -> f (a, 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
appSeq

eliminateSumStructureUnit :: (a, SumTypeExpression) -> f (a, [Type])
eliminateSumStructureUnit (a
name, SumTypeExpression
sumTypeExpression) =
  (,) a
name ([Type] -> (a, [Type])) -> f [Type] -> f (a, [Type])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SumTypeExpression -> f [Type]
forall (f :: * -> *).
Applicative f =>
SumTypeExpression -> f [Type]
eliminateSumTypeExpression SumTypeExpression
sumTypeExpression

eliminateSumTypeExpression :: SumTypeExpression -> f [Type]
eliminateSumTypeExpression =
  \ case
    Doc.SequenceSumTypeExpression [AppSeq]
a ->
      (AppSeq -> f Type) -> [AppSeq] -> f [Type]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((NonEmpty Type -> Type) -> f (NonEmpty Type) -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Type -> Type
AppType (f (NonEmpty Type) -> f Type)
-> (AppSeq -> f (NonEmpty Type)) -> AppSeq -> f Type
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AppSeq -> f (NonEmpty Type)
forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq) [AppSeq]
a
    Doc.StringSumTypeExpression [AppSeq]
a ->
      (AppSeq -> f Type) -> [AppSeq] -> f [Type]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((NonEmpty Type -> Type) -> f (NonEmpty Type) -> f Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Type -> Type
AppType (f (NonEmpty Type) -> f Type)
-> (AppSeq -> f (NonEmpty Type)) -> AppSeq -> f Type
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AppSeq -> f (NonEmpty Type)
forall (f :: * -> *). Applicative f => AppSeq -> f (NonEmpty Type)
eliminateTypeStringAppSeq) [AppSeq]
a

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

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
eliminateTypeStringUnit

eliminateTypeStringUnit :: Unit -> f Type
eliminateTypeStringUnit =
  \ case
    TypeString.InSquareBracketsUnit AppSeq
appSeq ->
      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 [AppSeq]
commaSeq ->
      [AppSeq] -> f [NonEmpty Type]
eliminateTypeStringCommaSeq [AppSeq]
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