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