module Domain.Models.TypeCentricDoc
where

import Domain.Prelude hiding (Product, Sum, Enum)
import qualified Domain.Models.TypeString as TypeString


type Doc =
  [(Text, Structure)]

data Structure =
  ProductStructure [(Text, NestedTypeExpression)] |
  SumStructure [(Text, [NestedTypeExpression])] |
  EnumStructure [Text]
  deriving (Int -> Structure -> ShowS
[Structure] -> ShowS
Structure -> String
(Int -> Structure -> ShowS)
-> (Structure -> String)
-> ([Structure] -> ShowS)
-> Show Structure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Structure] -> ShowS
$cshowList :: [Structure] -> ShowS
show :: Structure -> String
$cshow :: Structure -> String
showsPrec :: Int -> Structure -> ShowS
$cshowsPrec :: Int -> Structure -> ShowS
Show)

data NestedTypeExpression =
  AppSeqNestedTypeExpression TypeString.AppSeq |
  StructureNestedTypeExpression Structure
  deriving (Int -> NestedTypeExpression -> ShowS
[NestedTypeExpression] -> ShowS
NestedTypeExpression -> String
(Int -> NestedTypeExpression -> ShowS)
-> (NestedTypeExpression -> String)
-> ([NestedTypeExpression] -> ShowS)
-> Show NestedTypeExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NestedTypeExpression] -> ShowS
$cshowList :: [NestedTypeExpression] -> ShowS
show :: NestedTypeExpression -> String
$cshow :: NestedTypeExpression -> String
showsPrec :: Int -> NestedTypeExpression -> ShowS
$cshowsPrec :: Int -> NestedTypeExpression -> ShowS
Show)