idk ^w^

src/Gyehoek/Sexp.hs

@@ -35,11 +35,13 @@ module Gyehoek.Sexp
   , sxs
   , makeSx
   , makeSxs
+  , makeSx'
   , toSexp
   , fromSexp
   , stripLocation
   , format
   , equivalent
+  , encodeOrShow
   )
   where
 
@@ -84,6 +86,7 @@ import Debug.Pretty.Simple
 import qualified Data.Vector as V
 import qualified Data.Vector.Strict
 import Data.Function (on)
+import Data.String (IsString (fromString))
 
 
 sexp :: SexpIso a => Iso' a Text
@@ -385,6 +388,11 @@ deriving instance Lift SL.Atom
 deriving instance Lift SL.Position
 deriving instance Lift SL.Prefix
 
+encodeOrShow :: (SexpIso a, Show a, IsString s) => a -> s
+encodeOrShow a = fromString case encode a of
+  Left _ -> show a
+  Right e -> T.unpack e
+
 extQ :: (Typeable a, Typeable b) => (a -> r) -> (b -> r) -> a -> r
 extQ f g a = maybe (f a) g (cast a)
 
@@ -404,13 +412,15 @@ makeSxs f = QuasiQuoter
   , quoteDec = undefined
   }
 
-makeSx :: Data r => Code Q (Sexp -> r) -> QuasiQuoter
-makeSx f = QuasiQuoter
+-- | An untyped variant of 'makeSx', useful when the user function is
+-- polymorphic in its return value.
+makeSx' :: ExpQ -> QuasiQuoter
+makeSx' f = QuasiQuoter
   { quoteExp = \str -> do
       pos <- getPos
       case readSexpWithPos pos (T.pack str) of
         Left e -> fail e
-        Right x -> [| $(unTypeCode f) $e |]
+        Right x -> [| $f $e |]
           where
             e = dataToExpQ
               (const Nothing `extQ` metaSexp `extQ` metaSexps)
@@ -420,5 +430,8 @@ makeSx f = QuasiQuoter
   , quoteDec = undefined
   }
 
+makeSx :: Data r => Code Q (Sexp -> r) -> QuasiQuoter
+makeSx = makeSx' . unTypeCode
+
 sxs = makeSxs [||id||]
 sx = makeSx [||id||]