{-# 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


type Name = Text

data Prim = PrimAdd | PrimSub | PrimMul | PrimDiv
  deriving (Show, Generic)

data Val
  = ValInt Int
  | ValNil
  | ValPrim Prim
  | ValLambda (List Name) Exp
  | ValVar Name
  deriving (Show, Generic)

data Exp
  = ExpLet (List (Name, Exp)) Exp
  | ExpApply Exp (List Exp)
  | ExpBegin (List Exp)
  | ExpVal Val
  deriving (Show, Generic)



letIso
  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> (forall t. Grammar Position (Sexp :- t) (b :- t))
  -> Grammar Position (Sexp :- (List (a, b) :- t1)) t2
  -> Grammar Position (Sexp :- t1) t2
letIso name rhs e = list (el (sym "let") >>> el bindings >>> el e)
  where
    -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
    bindings = list $ rest binding
    binding :: forall t. Grammar Position (Sexp :- t) ((_, _) :- t)
    binding = list (el name >>> el rhs) >>> pair

instance SexpIso Prim where
  sexpIso = match
    $ With (. sym "+")
    $ With (. sym "-")
    $ With (. sym "*")
    $ With (. sym "/")
    $ End

instance SexpIso Val where
  sexpIso = match
    $ With (. sexpIso)
    $ With (. sym "nil")
    $ With (. sexpIso)
    $ With lam
    $ With (\var -> var . symbol)
    $ End
    where
      lam q = q . list
        ( el (sym "lambda")
          >>> el (sexpIso @(List Name))
          >>> el sexpIso )

instance SexpIso Exp where
  sexpIso = match
    $ With (. letIso symbol sexpIso sexpIso)
    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
    $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
    $ With (<<< sexpIso)
    $ End