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