module Bookhound.Parsers.String where

import Bookhound.Parser            (Parser)
import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, maybeWithinBoth,
                                    within, withinBoth, (->>-), (|*), (|+), (|?))
import Bookhound.Parsers.Char      (alpha, alphaNum, char, closeAngle,
                                    closeCurly, closeParens, closeSquare, digit,
                                    doubleQuote, letter, lower, newLine,
                                    openAngle, openCurly, openParens,
                                    openSquare, quote, space, spaceOrTab, tab,
                                    upper, whiteSpace)


string :: Parser String
string :: Parser String
string = (Parser Char
char |*)

word :: Parser String
word :: Parser String
word = (forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
whiteSpace |+)

digits :: Parser String
digits :: Parser String
digits = (Parser Char
digit |+)

uppers :: Parser String
uppers :: Parser String
uppers = (Parser Char
upper |+)

lowers :: Parser String
lowers :: Parser String
lowers = (Parser Char
lower |+)

letters :: Parser String
letters :: Parser String
letters = (Parser Char
letter |+)

alphas :: Parser String
alphas :: Parser String
alphas = (Parser Char
alpha |+)

alphaNums :: Parser String
alphaNums :: Parser String
alphaNums = (Parser Char
alphaNum |+)



spaces :: Parser String
spaces :: Parser String
spaces = (Parser Char
space |+)

tabs :: Parser String
tabs :: Parser String
tabs = (Parser Char
tab |+)

newLines :: Parser String
newLines :: Parser String
newLines = (Parser Char
newLine |+)

spacesOrTabs :: Parser String
spacesOrTabs :: Parser String
spacesOrTabs = (Parser Char
spaceOrTab |+)

spacing :: Parser String
spacing :: Parser String
spacing = (Parser Char
whiteSpace |+)

blankLine :: Parser String
blankLine :: Parser String
blankLine = (Parser String
spacesOrTabs |?) forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
->>- Parser Char
newLine

blankLines :: Parser String
blankLines :: Parser String
blankLines = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
blankLine |+)



withinQuotes :: Parser b -> Parser b
withinQuotes :: forall b. Parser b -> Parser b
withinQuotes = forall a b. Parser a -> Parser b -> Parser b
within Parser Char
quote

withinDoubleQuotes :: Parser b -> Parser b
withinDoubleQuotes :: forall b. Parser b -> Parser b
withinDoubleQuotes = forall a b. Parser a -> Parser b -> Parser b
within Parser Char
doubleQuote

withinParens :: Parser b -> Parser b
withinParens :: forall b. Parser b -> Parser b
withinParens = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth Parser Char
openParens Parser Char
closeParens

withinSquareBrackets :: Parser b -> Parser b
withinSquareBrackets :: forall b. Parser b -> Parser b
withinSquareBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth Parser Char
openSquare Parser Char
closeSquare

withinCurlyBrackets :: Parser b -> Parser b
withinCurlyBrackets :: forall b. Parser b -> Parser b
withinCurlyBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth Parser Char
openCurly Parser Char
closeCurly

withinAngleBrackets :: Parser b -> Parser b
withinAngleBrackets :: forall b. Parser b -> Parser b
withinAngleBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
withinBoth Parser Char
openAngle Parser Char
closeAngle



maybeWithinQuotes :: Parser b -> Parser b
maybeWithinQuotes :: forall b. Parser b -> Parser b
maybeWithinQuotes = forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser Char
quote

maybeWithinDoubleQuotes :: Parser b -> Parser b
maybeWithinDoubleQuotes :: forall b. Parser b -> Parser b
maybeWithinDoubleQuotes = forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser Char
doubleQuote

maybeWithinParens :: Parser b -> Parser b
maybeWithinParens :: forall b. Parser b -> Parser b
maybeWithinParens = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser Char
openParens Parser Char
closeParens

maybeWithinSquareBrackets :: Parser b -> Parser b
maybeWithinSquareBrackets :: forall b. Parser b -> Parser b
maybeWithinSquareBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser Char
openSquare Parser Char
closeSquare

maybeWithinCurlyBrackets :: Parser b -> Parser b
maybeWithinCurlyBrackets :: forall b. Parser b -> Parser b
maybeWithinCurlyBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser Char
openCurly Parser Char
closeCurly

maybeWithinAngleBrackets :: Parser b -> Parser b
maybeWithinAngleBrackets :: forall b. Parser b -> Parser b
maybeWithinAngleBrackets = forall a b c. Parser a -> Parser b -> Parser c -> Parser c
maybeWithinBoth Parser Char
openAngle Parser Char
closeAngle