{-# LANGUAGE OverloadedStrings #-}

module Language.Virgil.AST where

import Data.ByteString.Lazy (ByteString)
import           Data.HashMap.Strict (HashMap, fromList)
import qualified Data.HashMap.Strict as HM
import Data.Scientific (Scientific)
import Data.Text (Text)
import           Data.Vector (Vector)
import qualified Data.Vector as V

type Ident = ByteString

-- | A top-level declaration.
data Decl
  = Fragment ChValue
  | DFun FunDec
  | DTyp TypDec
    deriving (Eq, Show)

type ChObject = HashMap Text ChValue
type ChArray  = Vector ChValue

mkArray :: [ChValue] -> ChValue
mkArray = ChArray . V.fromList

mkObject :: [(Text, ChValue)] -> ChValue
mkObject = ChObject . HM.fromList

data ChValue
  = ChObject ChObject
  | ChArray  ChArray
  | ChString Text
  | ChNumber Scientific
  | ChBool Bool
  | ChNull
  | ChQuote Expr
    deriving (Eq, Show)

data Typ
  = TApp Typ Typ
  | TNamed Ident
  | TArrow
  | TUnit
  | TVar Ident
  | TFix Ident Typ
  | TSum [(Ident, Typ)]
  | TProd [(Ident, Typ)]
  | TTup [Typ]
    deriving (Eq, Show)

data TypDec = TypDec
  { tdName :: Ident
  , tdVars :: [Ident]
  , tdBody :: Typ
  } deriving (Eq, Show)

data FunDec = FunDec
  { fdName  :: Ident
  , fdTyp   :: Maybe Typ
  , fdCases :: [FnCase]
  } deriving (Eq, Show)

data FnCase = FnCase
  { fcPat  :: Pattern
  , fcBody :: Expr
  } deriving (Eq, Show)

data Pattern
  = PConstr Ident Pattern
  | PVar Ident
  | PLit Literal
  | PTup [Pattern]
  | PUnderscore
    deriving (Eq, Show)

type Env = HashMap Ident Value

data Value
  = VConstr Ident Value
  | VRecord [(Ident, Value)]
  | VTup  [Value]
  | VLam [FnCase] Env
  | VLit Literal
    deriving (Eq, Show)

data Expr
  = ELit Literal
  | EConstr Ident
  | EApp Expr Expr
  | EVar Ident
  | ETup [Expr]
  | EList [Expr]
  | ERecord [(Ident, Expr)]
  | ELam [FnCase]
  | ETyped Expr Typ
  | EAccess Expr Ident
    deriving (Eq, Show)

data Literal
  = LInt Integer
  | LDouble Double
  | LString Text
  | LBool Bool
    deriving (Eq, Show)

{-
with fact : Int -> Int
  0 = 1
  n = n * fact (n - 1)
-}
fact :: Decl
fact = DFun $ FunDec
  { fdName = "fact"
  , fdTyp  = Just (TApp (TApp TArrow (TNamed "Int"))
                   (TNamed "Int"))
  , fdCases = [ FnCase { fcPat  = PLit (LInt 0)
                       , fcBody = ELit (LInt 1)
                       }
              , FnCase { fcPat  = PVar "n"
                       , fcBody = EApp (EApp (EVar "mul") (EVar "n"))
                                  (EApp (EVar "fact")
                                   (EApp (EApp
                                          (EVar "sub")
                                          (EVar "n"))
                                    (ELit (LInt 1))))
                       }
              ]
  }

{-
foo:
   bar: '(fact 5)
   baz: '(fact 10)
-}
foo :: Decl
foo = Fragment $ ChObject $ fromList
  [ ("foo", ChObject $ fromList
      [ ("bar", ChQuote (EApp (EVar "fact") (ELit (LInt 5))))
      , ("baz", ChQuote (EApp (EVar "fact") (ELit (LInt 10))))
      ]
    )
  ]