{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
module HSVIS.AST where

import Data.List.NonEmpty (NonEmpty)

import HSVIS.Pretty


newtype Name = Name String
  deriving (Show, Eq)

data Program t = Program [DataDef] [FunDef t]
  deriving (Show)

data DataDef = DataDef Name [Name] [(Name, [Type])]
  deriving (Show)

data FunDef t = FunDef Name (Maybe Type) (NonEmpty (FunEq t))
  deriving (Show)

data FunEq t = FunEq t Name [Pattern t] (RHS t)
  deriving (Show)

data TypeStage = TSTC | TSNormal
  deriving (Show)

data GType (stage :: TypeStage) where
  TApp :: GType s -> [GType s] -> GType s
  TTup :: [GType s] -> GType s
  TList :: GType s -> GType s
  TFun :: GType s -> GType s -> GType s
  TCon :: Name -> GType s
  TVar :: Name -> GType s

  -- Type constructor used only while type checking
  TUniVar :: Int -> GType 'TSTC
deriving instance Show (GType stage)

type TCType = GType 'TSTC
type Type = GType 'TSNormal

data Pattern t
  = PWildcard t
  | PVar t Name
  | PAs t Name (Pattern t)
  | PCon t Name [Pattern t]
  | POp t (Pattern t) Operator (Pattern t)
  | PList t [Pattern t]
  | PTup t [Pattern t]
  deriving (Show)

data RHS t
  = Guarded [(Expr t, Expr t)]  -- currently not parsed
  | Plain (Expr t)
  deriving (Show)

data Expr t
  = ELit t Literal
  | EVar t Name
  | ECon t Name
  | EList t [Expr t]
  | ETup t [Expr t]
  | EApp t (Expr t) [Expr t]
  | EOp t (Expr t) Operator (Expr t)
  | EIf t (Expr t) (Expr t) (Expr t)
  | ECase t (Expr t) [(Pattern t, RHS t)]
  | ELet t [FunDef t] (Expr t)
  | EParseError
  deriving (Show)

data Literal = LInt Integer | LFloat Rational | LChar Char | LString String
  deriving (Show)

data Operator = OAdd | OSub | OMul | ODiv | OMod | OEqu | OPow
              | OCons
  deriving (Show)

instance Pretty Name where
  prettysPrec _ (Name n) = showString ("\"" ++ n ++ "\"")