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
structureMapping) Maybe (Sequence Structure)
forall a. Maybe a
Nothing

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

sumTypeExpression :: Value [NestedTypeExpression]
sumTypeExpression =
  [Scalar [NestedTypeExpression]]
-> Maybe (Mapping [NestedTypeExpression])
-> Maybe (Sequence [NestedTypeExpression])
-> Value [NestedTypeExpression]
forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar [NestedTypeExpression]]
onScalar (Mapping [NestedTypeExpression]
-> Maybe (Mapping [NestedTypeExpression])
forall a. a -> Maybe a
Just Mapping [NestedTypeExpression]
onMapping) (Sequence [NestedTypeExpression]
-> Maybe (Sequence [NestedTypeExpression])
forall a. a -> Maybe a
Just Sequence [NestedTypeExpression]
onSequence)
  where
    onScalar :: [Scalar [NestedTypeExpression]]
onScalar =
      [
        [NestedTypeExpression] -> Scalar [NestedTypeExpression]
forall a. a -> Scalar a
nullScalar []
        ,
        ([AppSeq] -> [NestedTypeExpression])
-> Scalar [AppSeq] -> Scalar [NestedTypeExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AppSeq -> NestedTypeExpression)
-> [AppSeq] -> [NestedTypeExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AppSeq -> NestedTypeExpression
AppSeqNestedTypeExpression) (Scalar [AppSeq] -> Scalar [NestedTypeExpression])
-> Scalar [AppSeq] -> Scalar [NestedTypeExpression]
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
        ]
    onMapping :: Mapping [NestedTypeExpression]
onMapping =
      NestedTypeExpression -> [NestedTypeExpression]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NestedTypeExpression -> [NestedTypeExpression])
-> (Structure -> NestedTypeExpression)
-> Structure
-> [NestedTypeExpression]
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 (Structure -> [NestedTypeExpression])
-> Mapping Structure -> Mapping [NestedTypeExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Structure
structureMapping
    onSequence :: Sequence [NestedTypeExpression]
onSequence =
      Fold NestedTypeExpression [NestedTypeExpression]
-> Value NestedTypeExpression -> Sequence [NestedTypeExpression]
forall a b. Fold a b -> Value a -> Sequence b
foldSequence Fold NestedTypeExpression [NestedTypeExpression]
forall a. Fold a [a]
Fold.list Value NestedTypeExpression
nestedTypeExpression

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

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]


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

appTypeStringScalar :: Scalar AppSeq
appTypeStringScalar =
  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

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

structureMapping :: Mapping Structure
structureMapping =
  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, NestedTypeExpression)] -> Structure
ProductStructure ([(Text, NestedTypeExpression)] -> Structure)
-> Value [(Text, NestedTypeExpression)] -> Value Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value NestedTypeExpression -> Value [(Text, NestedTypeExpression)]
forall b. Value b -> Value [(Text, b)]
byFieldName Value NestedTypeExpression
nestedTypeExpression) 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, [NestedTypeExpression])] -> Structure
SumStructure ([(Text, [NestedTypeExpression])] -> Structure)
-> Value [(Text, [NestedTypeExpression])] -> Value Structure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value [NestedTypeExpression]
-> Value [(Text, [NestedTypeExpression])]
forall b. Value b -> Value [(Text, b)]
byFieldName Value [NestedTypeExpression]
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)