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 =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value forall {a}. [Scalar [a]]
onScalar (forall a. a -> Maybe a
Just Mapping [(Text, Structure)]
onMapping) forall a. Maybe a
Nothing
  where
    onScalar :: [Scalar [a]]
onScalar =
      [forall a. a -> Scalar a
nullScalar []]
    onMapping :: Mapping [(Text, Structure)]
onMapping =
      forall key val assoc a.
(key -> val -> assoc)
-> Fold assoc a -> String key -> Value val -> Mapping a
foldMapping (,) forall a. Fold a [a]
Fold.list String Text
typeNameString Value Structure
structure
      where
        typeNameString :: String Text
typeNameString =
          forall a. Text -> (Text -> Either Text a) -> String a
formattedString Text
"type name" 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 forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
a forall a. Eq a => a -> a -> Bool
== Char
'_') Text
t
                      then
                        forall a b. b -> Either a b
Right Text
input
                      else
                        forall a b. a -> Either a b
Left Text
"Contains invalid chars"
                  else
                    forall a b. a -> Either a b
Left Text
"First char is not upper-case"
              Maybe (Char, Text)
Nothing ->
                forall a b. a -> Either a b
Left Text
"Empty string"

structure :: Value Structure
structure =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [] (forall a. a -> Maybe a
Just Mapping Structure
structureMapping) forall a. Maybe a
Nothing

byFieldName :: Value val -> Value [(Text, val)]
byFieldName Value val
onElement =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value forall {a}. [Scalar [a]]
onScalar (forall a. a -> Maybe a
Just Mapping [(Text, val)]
onMapping) forall a. Maybe a
Nothing
  where
    onScalar :: [Scalar [a]]
onScalar =
      [forall a. a -> Scalar a
nullScalar []]
    onMapping :: Mapping [(Text, val)]
onMapping =
      forall key val assoc a.
(key -> val -> assoc)
-> Fold assoc a -> String key -> Value val -> Mapping a
foldMapping (,) forall a. Fold a [a]
Fold.list String Text
textString Value val
onElement

sumTypeExpression :: Value [NestedTypeExpression]
sumTypeExpression =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar [NestedTypeExpression]]
onScalar (forall a. a -> Maybe a
Just Mapping [NestedTypeExpression]
onMapping) (forall a. a -> Maybe a
Just Sequence [NestedTypeExpression]
onSequence)
  where
    onScalar :: [Scalar [NestedTypeExpression]]
onScalar =
      [
        forall a. a -> Scalar a
nullScalar []
        ,
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AppSeq -> NestedTypeExpression
AppSeqNestedTypeExpression) forall a b. (a -> b) -> a -> b
$
        forall a. String a -> Scalar a
stringScalar forall a b. (a -> b) -> a -> b
$ forall a. Text -> Parser a -> String a
attoparsedString Text
"Type signature" forall a b. (a -> b) -> a -> b
$
        forall {a}. Parser Text a -> Parser Text a
GeneralAttoparsec.only Parser Text [AppSeq]
TypeStringAttoparsec.commaSeq
        ]
    onMapping :: Mapping [NestedTypeExpression]
onMapping =
      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
. Structure -> NestedTypeExpression
StructureNestedTypeExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Structure
structureMapping
    onSequence :: Sequence [NestedTypeExpression]
onSequence =
      forall a b. Fold a b -> Value a -> Sequence b
foldSequence forall a. Fold a [a]
Fold.list Value NestedTypeExpression
nestedTypeExpression

nestedTypeExpression :: Value NestedTypeExpression
nestedTypeExpression =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar NestedTypeExpression
onScalar] (forall a. a -> Maybe a
Just Mapping NestedTypeExpression
onMapping) forall a. Maybe a
Nothing
  where
    onScalar :: Scalar NestedTypeExpression
onScalar =
      AppSeq -> NestedTypeExpression
AppSeqNestedTypeExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scalar AppSeq
appTypeStringScalar
    onMapping :: Mapping NestedTypeExpression
onMapping =
      Structure -> NestedTypeExpression
StructureNestedTypeExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Structure
structureMapping

enumVariants :: Value [Text]
enumVariants =
  forall a. Sequence a -> Value a
sequenceValue (forall a b. Fold a b -> Value a -> Sequence b
foldSequence forall a. Fold a [a]
Fold.list Value Text
variant)
  where
    variant :: Value Text
variant =
      forall a. [Scalar a] -> Value a
scalarsValue [forall a. String a -> Scalar a
stringScalar String Text
textString]


-- * Scalar
-------------------------

appTypeStringScalar :: Scalar AppSeq
appTypeStringScalar =
  forall a. String a -> Scalar a
stringScalar forall a b. (a -> b) -> a -> b
$ forall a. Text -> Parser a -> String a
attoparsedString Text
"Type signature" forall a b. (a -> b) -> a -> b
$
  forall {a}. Parser Text a -> Parser Text a
GeneralAttoparsec.only Parser Text AppSeq
TypeStringAttoparsec.appSeq

-- * Mapping
-------------------------

structureMapping :: Mapping Structure
structureMapping =
  forall a. CaseSensitive -> ByKey Text a -> Mapping a
byKeyMapping (Bool -> CaseSensitive
CaseSensitive Bool
True) forall a b. (a -> b) -> a -> b
$
    forall key a. key -> Value a -> ByKey key a
atByKey Text
"product" ([(Text, NestedTypeExpression)] -> Structure
ProductStructure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {val}. Value val -> Value [(Text, val)]
byFieldName Value NestedTypeExpression
nestedTypeExpression) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall key a. key -> Value a -> ByKey key a
atByKey Text
"sum" ([(Text, [NestedTypeExpression])] -> Structure
SumStructure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {val}. Value val -> Value [(Text, val)]
byFieldName Value [NestedTypeExpression]
sumTypeExpression) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall key a. key -> Value a -> ByKey key a
atByKey Text
"enum" ([Text] -> Structure
EnumStructure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value [Text]
enumVariants)