cps

app/Gyehoek/Sexp.hs

@@ -12,11 +12,18 @@ module Gyehoek.Sexp
   , parseSexps
   , prefixSugar
   , todo
+  , isoIso
+  , encodeWith
+  , decodeWith
+  , kappa
+  , lambda
+  , kappaKeyword
+  , lambdaKeyword
   )
 where
 
 import Data.Text (Text)
-import Language.SexpGrammar as Sexp hiding (List, encode, decode, iso)
+import Language.SexpGrammar as Sexp hiding (List, encode, decode, encodeWith, decodeWith, iso)
 import Language.SexpGrammar qualified as Sexp
 import Language.Sexp qualified as S
 import Language.SexpGrammar.Generic
@@ -44,10 +51,16 @@ sexp = iso
   (either error id . decode)
 
 encode :: SexpIso a => a -> Either String Text
-encode = (_Right %~ decodeUtf8 . view strict) . Sexp.encode
+encode = encodeWith sexpIso
 
 decode :: SexpIso a => Text -> Either String a
-decode = Sexp.decode . view lazy . encodeUtf8
+decode = decodeWith sexpIso
+
+encodeWith :: SexpGrammar a -> a -> Either String Text
+encodeWith g = (_Right %~ decodeUtf8 . view strict) . Sexp.encodeWith g
+
+decodeWith :: SexpGrammar a -> Text -> Either String a
+decodeWith g = Sexp.decodeWith g "FILE" . view lazy . encodeUtf8
 
 parseSexps :: SexpIso a => FilePath -> Text -> Either String (List a)
 parseSexps f = marshal . SexpLoc.parseSexps f . view lazy . encodeUtf8
@@ -64,11 +77,12 @@ nonempty a =
     IG.flipped nonEmptyGrammar
 
 let_
-  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
+  :: Text
+  -> (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)
+let_ kw name rhs e = list (el (sym kw) >>> el bindings >>> el e)
   where
     -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
     bindings = nonempty binding
@@ -101,11 +115,29 @@ todo = (IGB.Flip $ IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
     f _ = Left $ unexpected "todo"
     g _ = Left $ unexpected "todo"
 
+kappa
+  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
+  -> Grammar Position (Sexp :- List a :- t1) t2
+  -> Grammar Position (Sexp :- t1) t2
+kappa name e = list $
+  el kappaKeyword
+  >>> el (list $ rest name)
+  >>> el e
+
 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 lambdaKeyword
   >>> el (list $ rest name)
   >>> el e
+
+isoIso :: Iso' s a -> Grammar p (s :- t) (a :- t)
+isoIso l = Sexp.iso (view l) (review l)
+
+kappaKeyword :: Grammar Position (Sexp :- t) t
+kappaKeyword = coproduct [ sym "κ", sym "kappa" ]
+
+lambdaKeyword :: Grammar Position (Sexp :- t) t
+lambdaKeyword = coproduct [ sym "λ", sym "lambda" ]