Copyright | © 2019 Vincent Archambault |
---|---|
License | 0BSD |
Maintainer | Vincent Archambault <archambault.v@gmail.com> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
This module includes everything you need to write a parser for
S-expression (SExpr
). It is based on the Text.Megaparsec
library and parsers can be defined for any kind of (MonadParsec
e
s m) instance. This is quite generic, if you are working with
streams of Char
, we suggest you also import
Data.SExpresso.Parse.Char or simply Data.SExpresso.Parse which
re-exports everything.
You can customize your SExpr
parser by specifying the following:
- The parser for atoms
- The opening tag, the closing tag, and a possible dependency of the closing tag on the opening one.
- If some space is required or optional between any pair of atoms.
- How to parse space (ex: treat comments as whitespace)
Synopsis
- data SExprParser m b a = SExprParser (m c) (c -> m b) (m a) (m ()) (a -> a -> SpacingRule)
- getAtom :: SExprParser m b a -> m a
- getSpace :: SExprParser m b a -> m ()
- getSpacingRule :: SExprParser m b a -> a -> a -> SpacingRule
- setTags :: m c -> (c -> m b) -> SExprParser m b' a -> SExprParser m b a
- setTagsFromList :: MonadParsec e s m => [(Tokens s, Tokens s, b)] -> SExprParser m b' a -> SExprParser m b a
- setTagsFromMap :: MonadParsec e s m => Map (Tokens s) [(Tokens s, b)] -> SExprParser m b' a -> SExprParser m b a
- setSpace :: m () -> SExprParser m b a -> SExprParser m b a
- setSpacingRule :: (a -> a -> SpacingRule) -> SExprParser m b a -> SExprParser m b a
- setAtom :: m a -> (a -> a -> SpacingRule) -> SExprParser m b a' -> SExprParser m b a
- data SpacingRule
- spaceIsMandatory :: a -> a -> SpacingRule
- spaceIsOptional :: a -> a -> SpacingRule
- mkSpacingRule :: (a -> SpacingRule) -> a -> a -> SpacingRule
- withLocation :: MonadParsec e s m => SExprParser m b a -> SExprParser m (Located b) (Located a)
- parseSExprList :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a)
- parseSExpr :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a)
- decodeOne :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a)
- decode :: MonadParsec e s m => SExprParser m b a -> m [SExpr b a]
Documentation
data SExprParser m b a Source #
The
datatype defines how to parse an
SExprParser
m b a
. Most parsing functions require the underlying monad
SExpr
b am
to be an instance of (MonadParsec
e s m).
SExprParser | The |
|
getAtom :: SExprParser m b a -> m a Source #
The getAtom
function returns the parser for atoms of an SExprParser
object.
getSpace :: SExprParser m b a -> m () Source #
The getSpace
function returns the parser for whitespace of an SExprParser
object.
getSpacingRule :: SExprParser m b a -> a -> a -> SpacingRule Source #
The getSpacingRule
function returns spacing rule function of an SExprParser
object.
setTags :: m c -> (c -> m b) -> SExprParser m b' a -> SExprParser m b a Source #
The setTags
function updates a parser with a new parser for the opening and closing tags.
setTagsFromList :: MonadParsec e s m => [(Tokens s, Tokens s, b)] -> SExprParser m b' a -> SExprParser m b a Source #
The setTagsFromList
function helps you build the opening and
closing parsers from a list of triplets. Each triplet specifies a
stream of tokens to parse as the opening tag, a stream of tokens to
parse at the closing tag and what to return when this pair is
encountered. The setTagsFromList
can handle multiple triplets
with the same opening tags. See also setTagsFromMap
.
The example e1 parses "()" as
.SList
() []
e1 = setTagsFromList [("(", ")", ()] p
The example e2 parses both "()" and "[]" as
but does
not parse "(]" or "[)"SList
() []
e2 = setTagsFromList [("(", ")", ()), ("[", "]", ())] p
The example e3 parses "()" as
and "#()" as
SList
List []
, but does not parse "(]" or "[)"SList
Vector []
e3 = setTagsFromList [("(", ")", List), ("#(",")",Vector)] p
The example e4 parses "()" as
and "(]" as
SList
')' []
, but does not parse "])"SList
']' []
e4 = setTagsFromList [("(", ")", ')'), ("(", "]", ']')] p
setTagsFromMap :: MonadParsec e s m => Map (Tokens s) [(Tokens s, b)] -> SExprParser m b' a -> SExprParser m b a Source #
The setTagsFromMap
function helps you build the opening and
closing parsers from a map. Each key specifies a stream of tokens to
parse as the opening tag and the value of the map specifies one or
more streams of tokens to parse at the closing tag and what to
return when this pair is encountered. See also setTagsFromList
.
The example e1 parses "()" as
.SList
() []
e1 = setTagsFromList $ M.fromList [("(", [")", ()]] p
The example e2 parses both "()" and "[]" as
but does
not parse "(]" or "[)"SList
() []
e2 = setTagsFromList $ M.fromList [("(", [")", ()]), ("[", ["]", ()])] p
The example e3 parses "()" as
and "#()" as
SList
List []
, but does not parse "(]" or "[)"SList
Vector []
e3 = setTagsFromList $ M.fromList [("(", [")", List]), ("#(", [")",Vector])] p
The example e4 parses "()" as
and "(]" as
SList
')' []
, but does not parse "])"SList
']' []
e4 = setTagsFromList $ M.fromList [("(", [(")", ')'), ("]", ']')])] p
setSpace :: m () -> SExprParser m b a -> SExprParser m b a Source #
The setSpace
function modifies a SExprParser
by setting the
parser to parse whitespace. The parser for whitespace must not
accept the empty input (e.g. space1
)
setSpacingRule :: (a -> a -> SpacingRule) -> SExprParser m b a -> SExprParser m b a Source #
The setSpacingRule
function modifies a SExprParser
by setting
the function to tell if two consecutive atoms must be separated by
space or not. See also mkSpacingRule
.
setAtom :: m a -> (a -> a -> SpacingRule) -> SExprParser m b a' -> SExprParser m b a Source #
The setAtom
function updates a parser with a new parser for atoms and and new spacing rule function.
data SpacingRule Source #
The SpacingRule
datatype is used to indicate if space is optional or mandatory between two consecutive
.SAtom
_
SMandatory | Space is mandatory |
SOptional | Space is optional |
Instances
Eq SpacingRule Source # | |
Defined in Data.SExpresso.Parse.Generic (==) :: SpacingRule -> SpacingRule -> Bool # (/=) :: SpacingRule -> SpacingRule -> Bool # | |
Show SpacingRule Source # | |
Defined in Data.SExpresso.Parse.Generic showsPrec :: Int -> SpacingRule -> ShowS # show :: SpacingRule -> String # showList :: [SpacingRule] -> ShowS # |
spaceIsMandatory :: a -> a -> SpacingRule Source #
The spaceIsMandatory
function is a spacing rule where space is always mandatory. See also getSpacingRule
.
spaceIsOptional :: a -> a -> SpacingRule Source #
The spaceIsOptional
function is a spacing rule where space is always optional. See also getSpacingRule
.
mkSpacingRule :: (a -> SpacingRule) -> a -> a -> SpacingRule Source #
The mkSpacingRule
function is a helper to create a valid
spacing rule function for SExprParser
when some atoms have the
same SpacingRule
both before and after no matter what the other
atom is. It takes as argument a function f
that takes a single
atom and returns the SpacingRule
that applies both before and
after this atom.
For example, to create a spacing rule where space is optional both
before and after the fictitious MyString
token:
s (MyString _) = SOptional s _ = Mandatory spacingRule = mkSpacingRule s
The above is equivalent to :
spacingRule (MyString _) _ = SOptional spacingRule _ (MyString _) = SOptional spacingRule _ _ = SMandatory
withLocation :: MonadParsec e s m => SExprParser m b a -> SExprParser m (Located b) (Located a) Source #
The withLocation
function adds source location to a
. See also SExprParser
Location
.
parseSExprList :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a) Source #
The parseSExprList
function return a parser for parsing S-expression of the form
.SList
_ _
parseSExpr :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a) Source #
decodeOne :: MonadParsec e s m => SExprParser m b a -> m (SExpr b a) Source #
The decodeOne
function return a parser for parsing a file
containing only one S-expression (SExpr
). It can parse extra
whitespace at the beginning and at the end of the file. See also
parseSExpr
and decode
.
decode :: MonadParsec e s m => SExprParser m b a -> m [SExpr b a] Source #
The decode
function return a parser for parsing a file
containing many S-expression (SExpr
). It can parse extra
whitespace at the beginning and at the end of the file. See also
parseSExpr
and decodeOne
.