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]