app/Gyehoek/Sexp.hs

@@ -0,0 +1,33 @@
+{-# 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 ((:|)))
+
+
+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