module SyntaxTrees.Purescript.DataDef where

import SyntaxTrees.Purescript.Common (Ctor, Var)
import SyntaxTrees.Purescript.Type   (AnyKindedType, Type, TypeCtor, TypeParam,
                                      showTypeNested)
import Utils.String                  (joinWords, str, wrapCurlyCsv, wrapSpaces)


data TypeDef
  = TypeDef
      { TypeDef -> TypeCtor
alias      :: TypeCtor
      , TypeDef -> [TypeParam]
typeParams :: [TypeParam]
      , TypeDef -> AnyKindedType
type'      :: AnyKindedType
      }

data NewTypeDef
  = NewTypeDef
      { NewTypeDef -> TypeCtor
type'      :: TypeCtor
      , NewTypeDef -> [TypeParam]
typeParams :: [TypeParam]
      , NewTypeDef -> Ctor
ctor       :: Ctor
      , NewTypeDef -> FieldDef
field      :: FieldDef
      }

data DataDef
  = DataDef
      { DataDef -> TypeCtor
type'      :: TypeCtor
      , DataDef -> [TypeParam]
typeParams :: [TypeParam]
      , DataDef -> [DataCtorDef]
ctorDefs   :: [DataCtorDef]
      }

data DataCtorDef
  = UnNamedFieldsCtor
      { DataCtorDef -> Ctor
ctor          :: Ctor
      , DataCtorDef -> [UnNamedFieldDef]
unnamedFields :: [UnNamedFieldDef]
      }
  | NamedFieldsCtor
      { ctor        :: Ctor
      , DataCtorDef -> [NamedFieldDef]
namedFields :: [NamedFieldDef]
      }

data FieldDef
  = UnNamedField UnNamedFieldDef
  | NamedField NamedFieldDef

data UnNamedFieldDef
  = UnNamedFieldDef
      { UnNamedFieldDef -> Type
type' :: Type
      }

data NamedFieldDef
  = NamedFieldDef
      { NamedFieldDef -> Var
name  :: Var
      , NamedFieldDef -> Type
type' :: Type
      }


instance Show TypeDef where
  show :: TypeDef -> String
show (TypeDef TypeCtor
x [TypeParam]
y AnyKindedType
z) =
    [String] -> String
joinWords [String
"type",
               forall a. Show a => a -> String
show TypeCtor
x,
               forall a. Show a => String -> [a] -> String
str String
" " [TypeParam]
y,
               String
"=",
               forall a. Show a => a -> String
show AnyKindedType
z]

instance Show NewTypeDef where
  show :: NewTypeDef -> String
show (NewTypeDef TypeCtor
x [TypeParam]
y Ctor
z FieldDef
t) =
    [String] -> String
joinWords [String
"newtype",
               forall a. Show a => a -> String
show TypeCtor
x,
               forall a. Show a => String -> [a] -> String
str String
" " [TypeParam]
y,
               String
"=",
               forall a. Show a => a -> String
show Ctor
z,
               forall a. Show a => a -> String
show FieldDef
t]

instance Show DataDef where
  show :: DataDef -> String
show (DataDef TypeCtor
x [TypeParam]
y [DataCtorDef]
z) =
    [String] -> String
joinWords [String
"data",
               forall a. Show a => a -> String
show TypeCtor
x,
               forall a. Show a => String -> [a] -> String
str String
" " [TypeParam]
y,
               String
"=",
               forall a. Show a => String -> [a] -> String
str (ShowS
wrapSpaces String
"|") [DataCtorDef]
z]

instance Show DataCtorDef where
  show :: DataCtorDef -> String
show (UnNamedFieldsCtor Ctor
x [UnNamedFieldDef]
y) =
    [String] -> String
joinWords [forall a. Show a => a -> String
show Ctor
x,
               forall a. Show a => String -> [a] -> String
str String
" " [UnNamedFieldDef]
y]

  show (NamedFieldsCtor Ctor
x [NamedFieldDef]
y) =
    [String] -> String
joinWords [forall a. Show a => a -> String
show Ctor
x,
               forall a. Show a => [a] -> String
wrapCurlyCsv [NamedFieldDef]
y]

instance Show FieldDef where
  show :: FieldDef -> String
show (UnNamedField UnNamedFieldDef
x) = forall a. Show a => a -> String
show UnNamedFieldDef
x
  show (NamedField NamedFieldDef
x)   = forall a. Show a => a -> String
show NamedFieldDef
x

instance Show UnNamedFieldDef where
  show :: UnNamedFieldDef -> String
show (UnNamedFieldDef Type
x) = Type -> String
showTypeNested Type
x

instance Show NamedFieldDef where
  show :: NamedFieldDef -> String
show (NamedFieldDef Var
x Type
y) =
    [String] -> String
joinWords [forall a. Show a => a -> String
show Var
x,
               String
"::",
               forall a. Show a => a -> String
show Type
y]