|
@@ -5,13 +5,17 @@ module Data.SCargot.Language.Basic
|
|
-- $descr
|
|
-- $descr
|
|
basicParser
|
|
basicParser
|
|
, basicPrinter
|
|
, basicPrinter
|
|
|
|
+ , locatedBasicParser
|
|
) where
|
|
) where
|
|
|
|
|
|
import Control.Applicative ((<$>))
|
|
import Control.Applicative ((<$>))
|
|
import Data.Char (isAlphaNum)
|
|
import Data.Char (isAlphaNum)
|
|
import Text.Parsec (many1, satisfy)
|
|
import Text.Parsec (many1, satisfy)
|
|
import Data.Text (Text, pack)
|
|
import Data.Text (Text, pack)
|
|
|
|
+import Data.Functor.Identity (Identity)
|
|
|
|
+import Text.Parsec.Prim (ParsecT)
|
|
|
|
|
|
|
|
+import Data.SCargot.Common (Located, located)
|
|
import Data.SCargot.Repr.Basic (SExpr)
|
|
import Data.SCargot.Repr.Basic (SExpr)
|
|
import Data.SCargot ( SExprParser
|
|
import Data.SCargot ( SExprParser
|
|
, SExprPrinter
|
|
, SExprPrinter
|
|
@@ -25,6 +29,9 @@ isAtomChar c = isAlphaNum c
|
|
|| c == '+' || c == '<' || c == '>'
|
|
|| c == '+' || c == '<' || c == '>'
|
|
|| c == '=' || c == '!' || c == '?'
|
|
|| c == '=' || c == '!' || c == '?'
|
|
|
|
|
|
|
|
+pToken :: ParsecT Text a Identity Text
|
|
|
|
+pToken = pack <$> many1 (satisfy isAtomChar)
|
|
|
|
+
|
|
-- $descr
|
|
-- $descr
|
|
-- The 'basicSpec' describes S-expressions whose atoms are simply
|
|
-- The 'basicSpec' describes S-expressions whose atoms are simply
|
|
-- text strings that contain alphanumeric characters and a small
|
|
-- text strings that contain alphanumeric characters and a small
|
|
@@ -43,7 +50,16 @@ isAtomChar c = isAlphaNum c
|
|
-- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)]
|
|
-- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)]
|
|
basicParser :: SExprParser Text (SExpr Text)
|
|
basicParser :: SExprParser Text (SExpr Text)
|
|
basicParser = mkParser pToken
|
|
basicParser = mkParser pToken
|
|
- where pToken = pack <$> many1 (satisfy isAtomChar)
|
|
|
|
|
|
+
|
|
|
|
+-- | A 'basicParser' which produces 'Located' values
|
|
|
|
+--
|
|
|
|
+-- >>> decode locatedBasicParser $ pack "(1 elephant)"
|
|
|
|
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
|
|
|
|
+--
|
|
|
|
+-- >>> decode locatedBasicParser $ pack "(let ((x 1))\n x)"
|
|
|
|
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 5)) "let")) (SCons (SCons (SCons (SAtom (At (Span (line 1, column 8) (line 1, column 9)) "x")) (SCons (SAtom (At (Span (line 1, column 10) (line 1, column 11)) "1")) SNil)) SNil) (SCons (SAtom (At (Span (line 2, column 3) (line 2, column 4)) "x")) SNil))]
|
|
|
|
+locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
|
|
|
|
+locatedBasicParser = mkParser $ located pToken
|
|
|
|
|
|
-- | A 'SExprPrinter' that prints textual atoms directly (without quoting
|
|
-- | A 'SExprPrinter' that prints textual atoms directly (without quoting
|
|
-- or any other processing) onto a single line.
|
|
-- or any other processing) onto a single line.
|