module Domain.YamlUnscrambler.TypeCentricDoc where import Domain.Prelude import Domain.Models.TypeCentricDoc import YamlUnscrambler import qualified Domain.Attoparsec.TypeString as TypeStringAttoparsec import qualified Domain.Attoparsec.General as GeneralAttoparsec import qualified Control.Foldl as Fold import qualified Data.Text as Text doc :: Value [(Text, Structure)] doc = [Scalar [(Text, Structure)]] -> Maybe (Mapping [(Text, Structure)]) -> Maybe (Sequence [(Text, Structure)]) -> Value [(Text, Structure)] forall a. [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a value [Scalar [(Text, Structure)]] forall a. [Scalar [a]] onScalar (Mapping [(Text, Structure)] -> Maybe (Mapping [(Text, Structure)]) forall a. a -> Maybe a Just Mapping [(Text, Structure)] onMapping) Maybe (Sequence [(Text, Structure)]) forall a. Maybe a Nothing where onScalar :: [Scalar [a]] onScalar = [[a] -> Scalar [a] forall a. a -> Scalar a nullScalar []] onMapping :: Mapping [(Text, Structure)] onMapping = (Text -> Structure -> (Text, Structure)) -> Fold (Text, Structure) [(Text, Structure)] -> String Text -> Value Structure -> Mapping [(Text, Structure)] forall key val assoc a. (key -> val -> assoc) -> Fold assoc a -> String key -> Value val -> Mapping a foldMapping (,) Fold (Text, Structure) [(Text, Structure)] forall a. Fold a [a] Fold.list String Text typeNameString Value Structure structure where typeNameString :: String Text typeNameString = Text -> (Text -> Either Text Text) -> String Text forall a. Text -> (Text -> Either Text a) -> String a formattedString Text "type name" ((Text -> Either Text Text) -> String Text) -> (Text -> Either Text Text) -> String Text forall a b. (a -> b) -> a -> b $ \ Text input -> case Text -> Maybe (Char, Text) Text.uncons Text input of Just (Char h, Text t) -> if Char -> Bool isUpper Char h then if (Char -> Bool) -> Text -> Bool Text.all (\ Char a -> Char -> Bool isAlphaNum Char a Bool -> Bool -> Bool || Char a Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\'' Bool -> Bool -> Bool || Char a Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '_') Text t then Text -> Either Text Text forall a b. b -> Either a b Right Text input else Text -> Either Text Text forall a b. a -> Either a b Left Text "Contains invalid chars" else Text -> Either Text Text forall a b. a -> Either a b Left Text "First char is not upper-case" Maybe (Char, Text) Nothing -> Text -> Either Text Text forall a b. a -> Either a b Left Text "Empty string" structure :: Value Structure structure = [Scalar Structure] -> Maybe (Mapping Structure) -> Maybe (Sequence Structure) -> Value Structure forall a. [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a value [] (Mapping Structure -> Maybe (Mapping Structure) forall a. a -> Maybe a Just Mapping Structure onMapping) Maybe (Sequence Structure) forall a. Maybe a Nothing where onMapping :: Mapping Structure onMapping = CaseSensitive -> ByKey Text Structure -> Mapping Structure forall a. CaseSensitive -> ByKey Text a -> Mapping a byKeyMapping (Bool -> CaseSensitive CaseSensitive Bool True) (ByKey Text Structure -> Mapping Structure) -> ByKey Text Structure -> Mapping Structure forall a b. (a -> b) -> a -> b $ Text -> Value Structure -> ByKey Text Structure forall key a. key -> Value a -> ByKey key a atByKey Text "product" ([(Text, AppSeq)] -> Structure ProductStructure ([(Text, AppSeq)] -> Structure) -> Value [(Text, AppSeq)] -> Value Structure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value AppSeq -> Value [(Text, AppSeq)] forall b. Value b -> Value [(Text, b)] byFieldName Value AppSeq appTypeString) ByKey Text Structure -> ByKey Text Structure -> ByKey Text Structure forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Value Structure -> ByKey Text Structure forall key a. key -> Value a -> ByKey key a atByKey Text "sum" ([(Text, SumTypeExpression)] -> Structure SumStructure ([(Text, SumTypeExpression)] -> Structure) -> Value [(Text, SumTypeExpression)] -> Value Structure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value SumTypeExpression -> Value [(Text, SumTypeExpression)] forall b. Value b -> Value [(Text, b)] byFieldName Value SumTypeExpression sumTypeExpression) ByKey Text Structure -> ByKey Text Structure -> ByKey Text Structure forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Value Structure -> ByKey Text Structure forall key a. key -> Value a -> ByKey key a atByKey Text "enum" ([Text] -> Structure EnumStructure ([Text] -> Structure) -> Value [Text] -> Value Structure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value [Text] enumVariants) byFieldName :: Value b -> Value [(Text, b)] byFieldName Value b onElement = [Scalar [(Text, b)]] -> Maybe (Mapping [(Text, b)]) -> Maybe (Sequence [(Text, b)]) -> Value [(Text, b)] forall a. [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a value [Scalar [(Text, b)]] forall a. [Scalar [a]] onScalar (Mapping [(Text, b)] -> Maybe (Mapping [(Text, b)]) forall a. a -> Maybe a Just Mapping [(Text, b)] onMapping) Maybe (Sequence [(Text, b)]) forall a. Maybe a Nothing where onScalar :: [Scalar [a]] onScalar = [[a] -> Scalar [a] forall a. a -> Scalar a nullScalar []] onMapping :: Mapping [(Text, b)] onMapping = (Text -> b -> (Text, b)) -> Fold (Text, b) [(Text, b)] -> String Text -> Value b -> Mapping [(Text, b)] forall key val assoc a. (key -> val -> assoc) -> Fold assoc a -> String key -> Value val -> Mapping a foldMapping (,) Fold (Text, b) [(Text, b)] forall a. Fold a [a] Fold.list String Text textString Value b onElement appTypeString :: Value AppSeq appTypeString = [Scalar AppSeq] -> Maybe (Mapping AppSeq) -> Maybe (Sequence AppSeq) -> Value AppSeq forall a. [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a value [ String AppSeq -> Scalar AppSeq forall a. String a -> Scalar a stringScalar (String AppSeq -> Scalar AppSeq) -> String AppSeq -> Scalar AppSeq forall a b. (a -> b) -> a -> b $ Text -> Parser AppSeq -> String AppSeq forall a. Text -> Parser a -> String a attoparsedString Text "Type signature" (Parser AppSeq -> String AppSeq) -> Parser AppSeq -> String AppSeq forall a b. (a -> b) -> a -> b $ Parser AppSeq -> Parser AppSeq forall a. Parser Text a -> Parser Text a GeneralAttoparsec.only Parser AppSeq TypeStringAttoparsec.appSeq ] Maybe (Mapping AppSeq) forall a. Maybe a Nothing Maybe (Sequence AppSeq) forall a. Maybe a Nothing sumTypeExpression :: Value SumTypeExpression sumTypeExpression = [Scalar SumTypeExpression] -> Maybe (Mapping SumTypeExpression) -> Maybe (Sequence SumTypeExpression) -> Value SumTypeExpression forall a. [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a value [Scalar SumTypeExpression] onScalar Maybe (Mapping SumTypeExpression) forall a. Maybe a Nothing (Sequence SumTypeExpression -> Maybe (Sequence SumTypeExpression) forall a. a -> Maybe a Just Sequence SumTypeExpression onSequence) where onScalar :: [Scalar SumTypeExpression] onScalar = [ SumTypeExpression -> Scalar SumTypeExpression forall a. a -> Scalar a nullScalar ([AppSeq] -> SumTypeExpression SequenceSumTypeExpression []) , ([AppSeq] -> SumTypeExpression) -> Scalar [AppSeq] -> Scalar SumTypeExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [AppSeq] -> SumTypeExpression StringSumTypeExpression (Scalar [AppSeq] -> Scalar SumTypeExpression) -> Scalar [AppSeq] -> Scalar SumTypeExpression forall a b. (a -> b) -> a -> b $ String [AppSeq] -> Scalar [AppSeq] forall a. String a -> Scalar a stringScalar (String [AppSeq] -> Scalar [AppSeq]) -> String [AppSeq] -> Scalar [AppSeq] forall a b. (a -> b) -> a -> b $ Text -> Parser [AppSeq] -> String [AppSeq] forall a. Text -> Parser a -> String a attoparsedString Text "Type signature" (Parser [AppSeq] -> String [AppSeq]) -> Parser [AppSeq] -> String [AppSeq] forall a b. (a -> b) -> a -> b $ Parser [AppSeq] -> Parser [AppSeq] forall a. Parser Text a -> Parser Text a GeneralAttoparsec.only Parser [AppSeq] TypeStringAttoparsec.commaSeq ] onSequence :: Sequence SumTypeExpression onSequence = [AppSeq] -> SumTypeExpression SequenceSumTypeExpression ([AppSeq] -> SumTypeExpression) -> Sequence [AppSeq] -> Sequence SumTypeExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Fold AppSeq [AppSeq] -> Value AppSeq -> Sequence [AppSeq] forall a b. Fold a b -> Value a -> Sequence b foldSequence Fold AppSeq [AppSeq] forall a. Fold a [a] Fold.list Value AppSeq appTypeString enumVariants :: Value [Text] enumVariants = Sequence [Text] -> Value [Text] forall a. Sequence a -> Value a sequenceValue (Fold Text [Text] -> Value Text -> Sequence [Text] forall a b. Fold a b -> Value a -> Sequence b foldSequence Fold Text [Text] forall a. Fold a [a] Fold.list Value Text variant) where variant :: Value Text variant = [Scalar Text] -> Value Text forall a. [Scalar a] -> Value a scalarsValue [String Text -> Scalar Text forall a. String a -> Scalar a stringScalar String Text textString]