-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Parsing all context-free grammars using Earley's algorithm. -- -- See https://www.github.com/ollef/Earley for more information -- and https://github.com/ollef/Earley/tree/master/examples for -- examples. @package Earley @version 0.11.0.1 -- | Context-free grammars. module Text.Earley.Grammar -- | A production. -- -- The type parameters are: -- -- a: The return type of the production. -- -- t for terminal: The type of the terminals that the production -- operates on. -- -- e for expected: The type of names, used for example to report -- expected tokens. -- -- r for rule: The type of a non-terminal. This plays a role -- similar to the s in the type ST s a. Since the -- parser function expects the r to be universally -- quantified, there is not much to do with this parameter other than -- leaving it universally quantified. -- -- As an example, Prod r String Char -- Int is the type of a production that returns an -- Int, operates on (lists of) characters and reports -- String names. -- -- Most of the functionality of Prods is obtained through its -- instances, e.g. Functor, Applicative, and -- Alternative. data Prod r e t a Terminal :: !(t -> Maybe a) -> !(Prod r e t (a -> b)) -> Prod r e t b NonTerminal :: !(r e t a) -> !(Prod r e t (a -> b)) -> Prod r e t b Pure :: a -> Prod r e t a Alts :: ![Prod r e t a] -> !(Prod r e t (a -> b)) -> Prod r e t b Many :: !(Prod r e t a) -> !(Prod r e t ([a] -> b)) -> Prod r e t b Named :: !(Prod r e t a) -> e -> Prod r e t a -- | Match a token for which the given predicate returns Just a, -- and return the a. terminal :: (t -> Maybe a) -> Prod r e t a -- | A named production (used for reporting expected things). () :: Prod r e t a -> e -> Prod r e t a -- | Smart constructor for alternatives. alts :: [Prod r e t a] -> Prod r e t (a -> b) -> Prod r e t b -- | A context-free grammar. -- -- The type parameters are: -- -- a: The return type of the grammar (often a Prod). -- -- r for rule: The type of a non-terminal. This plays a role -- similar to the s in the type ST s a. Since the -- parser function expects the r to be universally -- quantified, there is not much to do with this parameter other than -- leaving it universally quantified. -- -- Most of the functionality of Grammars is obtained through its -- instances, e.g. Monad and MonadFix. Note that GHC has -- syntactic sugar for MonadFix: use {-# LANGUAGE RecursiveDo -- #-} and mdo instead of do. data Grammar r a RuleBind :: Prod r e t a -> (Prod r e t a -> Grammar r b) -> Grammar r b FixBind :: (a -> Grammar r a) -> (a -> Grammar r b) -> Grammar r b Return :: a -> Grammar r a -- | Create a new non-terminal by giving its production. rule :: Prod r e t a -> Grammar r (Prod r e t a) -- | Run a grammar, given an action to perform on productions to be turned -- into non-terminals. runGrammar :: MonadFix m => (forall e t a. Prod r e t a -> m (Prod r e t a)) -> Grammar r b -> m b instance GHC.Base.Monoid (Text.Earley.Grammar.Prod r e t a) instance GHC.Base.Functor (Text.Earley.Grammar.Prod r e t) instance GHC.Base.Applicative (Text.Earley.Grammar.Prod r e t) instance GHC.Base.Alternative (Text.Earley.Grammar.Prod r e t) instance (Data.String.IsString t, GHC.Classes.Eq t, a ~ t) => Data.String.IsString (Text.Earley.Grammar.Prod r e t a) instance GHC.Base.Functor (Text.Earley.Grammar.Grammar r) instance GHC.Base.Applicative (Text.Earley.Grammar.Grammar r) instance GHC.Base.Monad (Text.Earley.Grammar.Grammar r) instance Control.Monad.Fix.MonadFix (Text.Earley.Grammar.Grammar r) -- | Derived operators. module Text.Earley.Derived -- | Match a token that satisfies the given predicate. Returns the matched -- token. satisfy :: (t -> Bool) -> Prod r e t t -- | Match a single token. token :: Eq t => t -> Prod r e t t -- | Match a single token and give it the name of the token. namedToken :: Eq t => t -> Prod r t t t -- | Match a list of tokens in sequence. list :: Eq t => [t] -> Prod r e t [t] -- | Match a ListLike of tokens in sequence. listLike :: (Eq t, ListLike i t) => i -> Prod r e t i -- | Deprecated: Use token instead symbol :: Eq t => t -> Prod r e t t -- | Deprecated: Use namedToken instead namedSymbol :: Eq t => t -> Prod r e t t -- | Deprecated: Use list or listLike instead word :: Eq t => [t] -> Prod r e t [t] -- | This module exposes the internals of the package: its API may change -- independently of the PVP-compliant version number. module Text.Earley.Internal -- | The concrete rule type that the parser uses data Rule s r e t a Rule :: ProdR s r e t a -> !(STRef s (STRef s [Cont s r e t a r])) -> !(Results s a) -> Rule s r e t a [ruleProd] :: Rule s r e t a -> ProdR s r e t a [ruleConts] :: Rule s r e t a -> !(STRef s (STRef s [Cont s r e t a r])) [ruleNulls] :: Rule s r e t a -> !(Results s a) mkRule :: ProdR s r e t a -> ST s (Rule s r e t a) prodNulls :: ProdR s r e t a -> Results s a -- | Remove (some) nulls from a production removeNulls :: ProdR s r e t a -> ProdR s r e t a type ProdR s r e t a = Prod (Rule s r) e t a resetConts :: Rule s r e t a -> ST s () newtype Results s a Results :: ST s [a] -> Results s a [unResults] :: Results s a -> ST s [a] lazyResults :: ST s [a] -> ST s (Results s a) data BirthPos Previous :: BirthPos Current :: BirthPos -- | An Earley state with result type a. data State s r e t a State :: !(ProdR s r e t a) -> !(a -> Results s b) -> !BirthPos -> !(Conts s r e t b c) -> State s r e t c Final :: !(Results s a) -> State s r e t a -- | A continuation accepting an a and producing a b. data Cont s r e t a b Cont :: !(a -> Results s b) -> !(ProdR s r e t (b -> c)) -> !(c -> Results s d) -> !(Conts s r e t d e') -> Cont s r e t a e' FinalCont :: (a -> Results s c) -> Cont s r e t a c data Conts s r e t a c Conts :: !(STRef s [Cont s r e t a c]) -> !(STRef s (Maybe (STRef s (Results s a)))) -> Conts s r e t a c [conts] :: Conts s r e t a c -> !(STRef s [Cont s r e t a c]) [contsArgs] :: Conts s r e t a c -> !(STRef s (Maybe (STRef s (Results s a)))) newConts :: STRef s [Cont s r e t a c] -> ST s (Conts s r e t a c) contraMapCont :: (b -> Results s a) -> Cont s r e t a c -> Cont s r e t b c contToState :: BirthPos -> Results s a -> Cont s r e t a c -> State s r e t c -- | Strings of non-ambiguous continuations can be optimised by removing -- indirections. simplifyCont :: Conts s r e t b a -> ST s [Cont s r e t b a] -- | Given a grammar, construct an initial state. initialState :: ProdR s a e t a -> ST s (State s a e t a) -- | A parsing report, which contains fields that are useful for presenting -- errors to the user if a parse is deemed a failure. Note however that -- we get a report even when we successfully parse something. data Report e i Report :: Int -> [e] -> i -> Report e i -- | The final position in the input (0-based) that the parser reached. [position] :: Report e i -> Int -- | The named productions processed at the final position. [expected] :: Report e i -> [e] -- | The part of the input string that was not consumed, which may be -- empty. [unconsumed] :: Report e i -> i -- | The result of a parse. data Result s e i a -- | The parser ended. Ended :: (Report e i) -> Result s e i a -- | The parser parsed a number of as. These are given as a -- computation, ST s [a] that constructs the as -- when run. We can thus save some work by ignoring this computation if -- we do not care about the results. The Int is the position in -- the input where these results were obtained, the i the rest -- of the input, and the last component is the continuation. Parsed :: (ST s [a]) -> Int -> i -> (ST s (Result s e i a)) -> Result s e i a safeHead :: ListLike i t => i -> Maybe t data ParseEnv s e i t a ParseEnv :: ![ST s [a]] -> ![State s a e t a] -> !(ST s ()) -> ![e] -> !Int -> !i -> ParseEnv s e i t a -- | Results ready to be reported (when this position has been processed) [results] :: ParseEnv s e i t a -> ![ST s [a]] -- | States to process at the next position [next] :: ParseEnv s e i t a -> ![State s a e t a] -- | Computation that resets the continuation refs of productions [reset] :: ParseEnv s e i t a -> !(ST s ()) -- | Named productions encountered at this position [names] :: ParseEnv s e i t a -> ![e] -- | The current position in the input string [curPos] :: ParseEnv s e i t a -> !Int -- | The input string [input] :: ParseEnv s e i t a -> !i emptyParseEnv :: i -> ParseEnv s e i t a -- | The internal parsing routine parse :: ListLike i t => [State s a e t a] -> ParseEnv s e i t a -> ST s (Result s e i a) -- | Create a parser from the given grammar. parser :: ListLike i t => (forall r. Grammar r (Prod r e t a)) -> ST s (i -> ST s (Result s e i a)) -- | Return all parses from the result of a given parser. The result may -- contain partial parses. The Ints are the position at which a -- result was produced. allParses :: (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([(a, Int)], Report e i) -- | Return all parses that reached the end of the input from the result of -- a given parser. fullParses :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([a], Report e i) -- | See e.g. how far the parser is able to parse the input string before -- it fails. This can be much faster than getting the parse results for -- highly ambiguous grammars. report :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> Report e i instance GHC.Base.Functor (Text.Earley.Internal.Result s e i) instance (GHC.Show.Show e, GHC.Show.Show i) => GHC.Show.Show (Text.Earley.Internal.Report e i) instance (GHC.Read.Read e, GHC.Read.Read i) => GHC.Read.Read (Text.Earley.Internal.Report e i) instance (GHC.Classes.Ord e, GHC.Classes.Ord i) => GHC.Classes.Ord (Text.Earley.Internal.Report e i) instance (GHC.Classes.Eq e, GHC.Classes.Eq i) => GHC.Classes.Eq (Text.Earley.Internal.Report e i) instance GHC.Classes.Eq Text.Earley.Internal.BirthPos instance GHC.Base.Functor (Text.Earley.Internal.Results s) instance GHC.Base.Applicative (Text.Earley.Internal.Results s) instance GHC.Base.Alternative (Text.Earley.Internal.Results s) instance GHC.Base.Monad (Text.Earley.Internal.Results s) instance GHC.Base.Monoid (Text.Earley.Internal.Results s a) -- | Parsing. module Text.Earley.Parser -- | A parsing report, which contains fields that are useful for presenting -- errors to the user if a parse is deemed a failure. Note however that -- we get a report even when we successfully parse something. data Report e i Report :: Int -> [e] -> i -> Report e i -- | The final position in the input (0-based) that the parser reached. [position] :: Report e i -> Int -- | The named productions processed at the final position. [expected] :: Report e i -> [e] -- | The part of the input string that was not consumed, which may be -- empty. [unconsumed] :: Report e i -> i -- | The result of a parse. data Result s e i a -- | The parser ended. Ended :: (Report e i) -> Result s e i a -- | The parser parsed a number of as. These are given as a -- computation, ST s [a] that constructs the as -- when run. We can thus save some work by ignoring this computation if -- we do not care about the results. The Int is the position in -- the input where these results were obtained, the i the rest -- of the input, and the last component is the continuation. Parsed :: (ST s [a]) -> Int -> i -> (ST s (Result s e i a)) -> Result s e i a -- | Create a parser from the given grammar. parser :: ListLike i t => (forall r. Grammar r (Prod r e t a)) -> ST s (i -> ST s (Result s e i a)) -- | Return all parses from the result of a given parser. The result may -- contain partial parses. The Ints are the position at which a -- result was produced. allParses :: (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([(a, Int)], Report e i) -- | Return all parses that reached the end of the input from the result of -- a given parser. fullParses :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([a], Report e i) -- | See e.g. how far the parser is able to parse the input string before -- it fails. This can be much faster than getting the parse results for -- highly ambiguous grammars. report :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> Report e i -- | Parsing all context-free grammars using Earley's algorithm. module Text.Earley -- | A production. -- -- The type parameters are: -- -- a: The return type of the production. -- -- t for terminal: The type of the terminals that the production -- operates on. -- -- e for expected: The type of names, used for example to report -- expected tokens. -- -- r for rule: The type of a non-terminal. This plays a role -- similar to the s in the type ST s a. Since the -- parser function expects the r to be universally -- quantified, there is not much to do with this parameter other than -- leaving it universally quantified. -- -- As an example, Prod r String Char -- Int is the type of a production that returns an -- Int, operates on (lists of) characters and reports -- String names. -- -- Most of the functionality of Prods is obtained through its -- instances, e.g. Functor, Applicative, and -- Alternative. data Prod r e t a -- | Match a token for which the given predicate returns Just a, -- and return the a. terminal :: (t -> Maybe a) -> Prod r e t a -- | A named production (used for reporting expected things). () :: Prod r e t a -> e -> Prod r e t a -- | A context-free grammar. -- -- The type parameters are: -- -- a: The return type of the grammar (often a Prod). -- -- r for rule: The type of a non-terminal. This plays a role -- similar to the s in the type ST s a. Since the -- parser function expects the r to be universally -- quantified, there is not much to do with this parameter other than -- leaving it universally quantified. -- -- Most of the functionality of Grammars is obtained through its -- instances, e.g. Monad and MonadFix. Note that GHC has -- syntactic sugar for MonadFix: use {-# LANGUAGE RecursiveDo -- #-} and mdo instead of do. data Grammar r a -- | Create a new non-terminal by giving its production. rule :: Prod r e t a -> Grammar r (Prod r e t a) -- | Match a token that satisfies the given predicate. Returns the matched -- token. satisfy :: (t -> Bool) -> Prod r e t t -- | Match a single token. token :: Eq t => t -> Prod r e t t -- | Match a single token and give it the name of the token. namedToken :: Eq t => t -> Prod r t t t -- | Match a list of tokens in sequence. list :: Eq t => [t] -> Prod r e t [t] -- | Match a ListLike of tokens in sequence. listLike :: (Eq t, ListLike i t) => i -> Prod r e t i -- | Deprecated: Use token instead symbol :: Eq t => t -> Prod r e t t -- | Deprecated: Use namedToken instead namedSymbol :: Eq t => t -> Prod r e t t -- | Deprecated: Use list or listLike instead word :: Eq t => [t] -> Prod r e t [t] -- | A parsing report, which contains fields that are useful for presenting -- errors to the user if a parse is deemed a failure. Note however that -- we get a report even when we successfully parse something. data Report e i Report :: Int -> [e] -> i -> Report e i -- | The final position in the input (0-based) that the parser reached. [position] :: Report e i -> Int -- | The named productions processed at the final position. [expected] :: Report e i -> [e] -- | The part of the input string that was not consumed, which may be -- empty. [unconsumed] :: Report e i -> i -- | The result of a parse. data Result s e i a -- | The parser ended. Ended :: (Report e i) -> Result s e i a -- | The parser parsed a number of as. These are given as a -- computation, ST s [a] that constructs the as -- when run. We can thus save some work by ignoring this computation if -- we do not care about the results. The Int is the position in -- the input where these results were obtained, the i the rest -- of the input, and the last component is the continuation. Parsed :: (ST s [a]) -> Int -> i -> (ST s (Result s e i a)) -> Result s e i a -- | Create a parser from the given grammar. parser :: ListLike i t => (forall r. Grammar r (Prod r e t a)) -> ST s (i -> ST s (Result s e i a)) -- | Return all parses from the result of a given parser. The result may -- contain partial parses. The Ints are the position at which a -- result was produced. allParses :: (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([(a, Int)], Report e i) -- | Return all parses that reached the end of the input from the result of -- a given parser. fullParses :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> ([a], Report e i) -- | See e.g. how far the parser is able to parse the input string before -- it fails. This can be much faster than getting the parse results for -- highly ambiguous grammars. report :: ListLike i t => (forall s. ST s (i -> ST s (Result s e i a))) -> i -> Report e i module Text.Earley.Mixfix data Associativity LeftAssoc :: Associativity NonAssoc :: Associativity RightAssoc :: Associativity -- | An identifier with identifier parts (Justs), and holes -- (Nothings) representing the positions of its arguments. -- -- Example (commonly written "if_then_else_"): [Just "if", -- Nothing, Just "then", Nothing, Just -- "else", Nothing] :: Holey String type Holey a = [Maybe a] -- | Create a grammar for parsing mixfix expressions. mixfixExpression :: [[(Holey (Prod r e t ident), Associativity)]] -> Prod r e t expr -> (Holey ident -> [expr] -> expr) -> Grammar r (Prod r e t expr) -- | A version of mixfixExpression with a separate semantic action -- for each individual Holey identifier. mixfixExpressionSeparate :: [[(Holey (Prod r e t ident), Associativity, Holey ident -> [expr] -> expr)]] -> Prod r e t expr -> Grammar r (Prod r e t expr) instance GHC.Show.Show Text.Earley.Mixfix.Associativity instance GHC.Classes.Eq Text.Earley.Mixfix.Associativity