snaillike.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<|>))
import qualified Data.SCargot as SCargot
import qualified Data.SCargot.Language.Basic as SCargot
import Data.SCargot.Repr.Basic
import Data.Text (Text)
import qualified Text.Parsec as Parsec

-- This takes an S-expression `x` and turns it into `(quote x)`
quoteExpression :: SExpr Text -> SExpr Text
quoteExpression expr = L ["quote", expr]

-- A reader macro is actually a `parsec` parser: this takes `parse`, a
-- parser which parses a single s-expression, and can do whatever it
-- wants with it. In this case, our "reader macro" just parses one
-- expression and wraps it in `(quote ...)`.
quoteReaderMacro :: SCargot.Reader Text
quoteReaderMacro parse = fmap quoteExpression parse

-- This reader macro is slightly more involved: this will parse zero
-- or more s-expressions, terminating when it sees the character ']'.
vecReaderMacro :: SCargot.Reader Text
vecReaderMacro parse =
  (Parsec.char ']' *> pure SNil) <|>
  (SCons <$> parse <*> vecReaderMacro parse)

parser :: SCargot.SExprParser Text (SExpr Text)
parser =
  -- install the quote reader to be invoked if we see a single quote
  SCargot.addReader '\'' quoteReaderMacro $
  -- install the vec reader to be invoked if we see a square bracket
  SCargot.addReader '[' vecReaderMacro $
  -- use the "basic" parser which just interprets aphanumeric
  -- sequences as atoms
  SCargot.basicParser

main :: IO ()
main =
  -- we can see this parses successfully, producing the same parse
  -- tree we'd get if we supplied the string
  -- "(let (x (quote foo)) x)"
  print (SCargot.decode parser "(let [x 'foo] x)")