Safe Haskell | None |
---|---|
Language | Haskell2010 |
- decode :: SExprParser atom carrier -> Text -> Either String [carrier]
- decodeOne :: SExprParser atom carrier -> Text -> Either String carrier
- data SExprParser atom carrier
- type Reader atom = Parser (SExpr atom) -> Parser (SExpr atom)
- type Comment = Parser ()
- mkParser :: Parser atom -> SExprParser atom (SExpr atom)
- setCarrier :: (b -> Either String c) -> SExprParser a b -> SExprParser a c
- addReader :: Char -> Reader a -> SExprParser a c -> SExprParser a c
- setComment :: Comment -> SExprParser a c -> SExprParser a c
- asRich :: SExprParser a (SExpr b) -> SExprParser a (RichSExpr b)
- asWellFormed :: SExprParser a (SExpr b) -> SExprParser a (WellFormedSExpr b)
- withQuote :: IsString t => SExprParser t (SExpr t) -> SExprParser t (SExpr t)
Parsing
decode :: SExprParser atom carrier -> Text -> Either String [carrier] Source #
Decode several S-expressions according to a given SExprParser
. This
will return a list of every S-expression that appears at the top-level
of the document.
decodeOne :: SExprParser atom carrier -> Text -> Either String carrier Source #
Decode a single S-expression. If any trailing input is left after
the S-expression (ignoring comments or whitespace) then this
will fail: for those cases, use decode
, which returns a list of
all the S-expressions found at the top level.
Parsing Control
data SExprParser atom carrier Source #
A SExprParser
describes a parser for a particular value
that has been serialized as an s-expression. The atom
parameter
corresponds to a Haskell type used to represent the atoms,
and the carrier
parameter corresponds to the parsed S-Expression
structure.
type Reader atom = Parser (SExpr atom) -> Parser (SExpr atom) Source #
A Reader
represents a reader macro: it takes a parser for
the S-Expression type and performs as much or as little
parsing as it would like, and then returns an S-expression.
type Comment = Parser () Source #
A Comment
represents any kind of skippable comment. This
parser must be able to fail if a comment is not being
recognized, and it must not consume any input in case
of failure.
mkParser :: Parser atom -> SExprParser atom (SExpr atom) Source #
Create a basic SExprParser
when given a parser
for an atom type.
>>>
import Text.Parsec (alphaNum, many1)
>>>
let parser = mkParser (many1 alphaNum)
>>>
decode parser "(ele phant)"
Right [SCons (SAtom "ele") (SCons (SAtom "phant") SNil)]
setCarrier :: (b -> Either String c) -> SExprParser a b -> SExprParser a c Source #
Modify the carrier type for a SExprParser
. This is
used internally to convert between various SExpr
representations,
but could also be used externally to add an extra conversion layer
onto a SExprParser
.
>>>
import Text.Parsec (alphaNum, many1)
>>>
import Data.SCargot.Repr (toRich)
>>>
let parser = setCarrier (return . toRich) (mkParser (many1 alphaNum))
>>>
decode parser "(ele phant)"
Right [RSlist [RSAtom "ele",RSAtom "phant"]]
addReader :: Char -> Reader a -> SExprParser a c -> SExprParser a c Source #
Add the ability to execute some particular reader macro, as
defined by its initial character and the Parser
which returns
the parsed S-Expression. The Reader
is passed a Parser
which
can be recursively called to parse more S-Expressions, and begins
parsing after the reader character has been removed from the
stream.
>>>
import Text.Parsec (alphaNum, char, many1)
>>>
let vecReader p = (char ']' *> pure SNil) <|> (SCons <$> p <*> vecReader p)
>>>
let parser = addReader '[' vecReader (mkParser (many1 alphaNum))
>>>
decode parser "(an [ele phant])"
Right [SCons (SAtom "an") (SCons (SCons (SAtom "ele") (SCons (SAtom "phant") SNil)) SNil)]
setComment :: Comment -> SExprParser a c -> SExprParser a c Source #
Add the ability to ignore some kind of comment. This gets
factored into whitespace parsing, and it's very important that
the parser supplied be able to fail (as otherwise it will
cause an infinite loop), and also that it not consume any input
(which may require it to be wrapped in try
.)
>>>
import Text.Parsec (alphaNum, anyChar, manyTill, many1, string)
>>>
let comment = string "//" *> manyTill anyChar newline *> pure ()
>>>
let parser = setComment comment (mkParser (many1 alphaNum))
>>>
decode parser "(ele //a comment\n phant)"
Right [SCons (SAtom "ele") (SCons (SAtom "phant") SNil)]
Specific SExprParser Conversions
asRich :: SExprParser a (SExpr b) -> SExprParser a (RichSExpr b) Source #
asWellFormed :: SExprParser a (SExpr b) -> SExprParser a (WellFormedSExpr b) Source #
Convert the final output representation from the SExpr
type
to the WellFormedSExpr
type.
>>>
import Text.Parsec (alphaNum, many1)
>>>
let parser = asWellFormed (mkParser (many1 alphaNum))
>>>
decode parser "(ele phant)"
Right [WFSList [WFSAtom "ele",WFSAtom "phant"]]
withQuote :: IsString t => SExprParser t (SExpr t) -> SExprParser t (SExpr t) Source #
Add the ability to understand a quoted S-Expression.
Many Lisps use 'sexpr
as sugar for (quote sexpr)
. This
assumes that the underlying atom type implements the IsString
class, and will create the quote
atom using fromString "quote"
.
>>>
import Text.Parsec (alphaNum, many1)
>>>
let parser = withQuote (mkParser (many1 alphaNum))
>>>
decode parser "'elephant"
Right [SCons (SAtom "quote") (SCons (SAtom "foo") SNil)]