{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Gyehoek.Sexp
  ( let_
  , nonempty
  )
where

import Data.Text (Text)
import Language.SexpGrammar as Sexp hiding (List)
import Language.SexpGrammar.Generic
import Data.InvertibleGrammar.Base qualified as IG
import Data.InvertibleGrammar.Base ((:-)((:-)))
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List (List)
import GHC.Generics


nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
nonempty a =
  list (el a >>> rest a) >>>
    pair >>> iso (uncurry (:|)) (\(x :| xs) -> (x, xs))

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

data DotList a = MkDotList (NonEmpty a) a
  deriving (Show, Generic)

dotlist :: (forall t. Grammar Position (Sexp :- t) (a :- t)) -> _
dotlist x = list $ rest $ coproduct
  [ x >>> _
  ]

lambda
  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
  -> Grammar Position (Sexp :- List a :- t1) t2
  -> Grammar Position (Sexp :- t1) t2
lambda name e = list $
  el (sym "lambda")
  >>> el (list $ rest name)
  >>> el e