module Domain.YamlUnscrambler.TypeCentricDoc where

import qualified Control.Foldl as Fold
import qualified Data.Text as Text
import qualified Domain.Attoparsec.General as GeneralAttoparsec
import qualified Domain.Attoparsec.TypeString as TypeStringAttoparsec
import Domain.Models.TypeCentricDoc
import qualified Domain.Models.TypeString as TypeStringModel
import Domain.Prelude
import YamlUnscrambler

doc :: Value [(Text, Structure)]
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 :: 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 :: forall val. 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 :: 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 forall {f :: * -> *}.
Applicative f =>
Mapping (f 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 a -> Parser a
GeneralAttoparsec.only Parser [AppSeq]
TypeStringAttoparsec.commaSeq
      ]
    onMapping :: Mapping (f 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 :: 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 :: 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 (NonEmpty TypeStringModel.Unit)
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 a -> Parser a
GeneralAttoparsec.only Parser AppSeq
TypeStringAttoparsec.appSeq

-- * Mapping

-------------------------

structureMapping :: Mapping Structure
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)