module Haskell.AST where

import Data.List


type Name = String
type TyVar = String

data AST = AST [Toplevel]
  deriving (Show, Eq)

data Toplevel = TopDef Def
              | TopDecl Decl
              | TopData Data
              | TopClass Class
              | TopInst Inst
  deriving (Show, Eq)

data Def = Def Name Expr
  deriving (Show, Eq)

data Expr = App Expr [Expr]
          | Ref Name
          | Num Integer
          | Tup [Expr]
          | Lam [Name] Expr
          | Case Expr [(Pat, Expr)]
  deriving (Show, Eq)

data Pat = PatAny
         | PatVar Name
         | PatCon Name [Pat]
         | PatTup [Pat]
  deriving (Show, Eq)

data Decl = Decl Name Type
  deriving (Show, Eq)

data Type = TyTup [Type]
          | TyInt
          | TyFun Type Type
          | TyRef Name [Type]
          | TyVar Name
          | TyVoid
  deriving (Show, Eq)

data Data = Data Name [TyVar] [(Name, [Type])]
  deriving (Show, Eq)

data Class = Class Name [TyVar] [Decl]
  deriving (Show, Eq)

data Inst = Inst Name Type [Def]
  deriving (Show, Eq)


class Pretty a where
    pretty :: a -> String

instance Pretty AST where
    pretty (AST tops) = intercalate "\n" (map pretty tops)

instance Pretty Toplevel where
    pretty (TopDef x) = pretty x
    pretty (TopDecl x) = pretty x
    pretty (TopData x) = pretty x
    pretty (TopClass x) = pretty x
    pretty (TopInst x) = pretty x

instance Pretty Def where
    pretty (Def n e) = n ++ " = " ++ pretty e

instance Pretty Expr where
    pretty (App e as) = "(" ++ intercalate " " (map pretty (e:as)) ++ ")"
    pretty (Ref n) = n
    pretty (Num n) = show n
    pretty (Tup es) = "(" ++ intercalate ", " (map pretty es) ++ ")"
    pretty (Lam as e) = "(\\" ++ intercalate " " as ++ " -> " ++ pretty e ++ ")"
    pretty (Case e arms) = "(case " ++ pretty e ++ " of { " ++ intercalate ";" (map go arms) ++ " })"
      where go (p, e') = pretty p ++ " -> " ++ pretty e'

instance Pretty Pat where
    pretty PatAny = "_"
    pretty (PatVar n) = n
    pretty (PatCon n ps) = "(" ++ n ++ " " ++ intercalate " " (map pretty ps) ++ ")"
    pretty (PatTup ps) = "(" ++ intercalate ", " (map pretty ps) ++ ")"

instance Pretty Decl where
    pretty (Decl n t) = n ++ " :: " ++ pretty t

instance Pretty Type where
    pretty (TyTup ts) = "(" ++ intercalate ", " (map pretty ts) ++ ")"
    pretty TyInt = "Int"
    pretty (TyFun t u) = "(" ++ pretty t ++ " -> " ++ pretty u ++ ")"
    pretty (TyRef n as) = "(" ++ n ++ " " ++ intercalate " " (map pretty as) ++ ")"
    pretty (TyVar n) = n
    pretty TyVoid = "#Void"

instance Pretty Data where
    pretty (Data n as cs) = "data " ++ n ++ " " ++ intercalate " " as ++ " = " ++ intercalate " | " (map go cs)
      where go (m, ts) = m ++ " " ++ intercalate " " (map pretty ts)

instance Pretty Class where
    pretty (Class n as ds) = "class " ++ n ++ " " ++ intercalate " " as ++ " where { " ++ intercalate " ; " (map pretty ds) ++ "}"

instance Pretty Inst where
    pretty (Inst n t ds) = "instance " ++ n ++ " " ++ pretty t ++ " where { " ++ intercalate " ; " (map pretty ds) ++ " }"