{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Gyehoek.Syntax where

import Data.Text (Text)
import Data.List (List)
import Language.SexpGrammar as Sexp hiding (List)
import Language.SexpGrammar.Generic
import GHC.Generics
import Prelude hiding ((.), id)
import Control.Category
import Data.List.NonEmpty (NonEmpty ((:|)))
import Gyehoek.Sexp qualified


type Name = Text

data Prim e
  = PrimAdd e e
  | PrimSub e e
  | PrimMul e e
  | PrimDiv e e
  deriving (Show, Generic, Functor, Foldable, Traversable)

data Lit
  = LitInt Int
  | LitNil
  | LitBool Bool
  deriving (Show, Generic)

data Exp
  = ExpLet (NonEmpty (Name, Exp)) Exp
  | ExpApply Exp (List Exp)
  | ExpBegin (List Exp)
  | ExpLit Lit
  | ExpPrim (Prim Exp)
  | ExpLambda (List Name) Exp
  | ExpVar Name
  deriving (Show, Generic)



instance SexpIso a => SexpIso (Prim a) where
  sexpIso = match
    $ With (. binop "prim-+")
    $ With (. binop "prim--")
    $ With (. binop "prim-*")
    $ With (. binop "prim-/")
    $ End
    where
      binop s = list $ el (sym s) >>> el sexpIso >>> el sexpIso

instance SexpIso Lit where
  sexpIso = match
    $ With (. sexpIso)
    $ With (. sym "nil")
    $ With (. sexpIso)
    $ End

instance SexpIso Exp where
  sexpIso = match
    $ With (. Gyehoek.Sexp.let_ symbol sexpIso sexpIso)
    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
    $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
    $ With (. sexpIso)
    $ With (. sexpIso)
    $ With (. lam)
    $ With (. symbol)
    $ End
    where
      lam = list
        ( el (sym "lambda")
          >>> el (sexpIso @(List Name))
          >>> el sexpIso )