| 1 |
{-# LANGUAGE LambdaCase #-}
|
| 2 |
|
| 1 | 3 |
module Text.Puggle.AST where
|
| 2 | 4 |
|
| 5 |
import Control.Applicative
|
| 6 |
|
| 7 |
-- | A definition has a name (which must be a unique, valid Haskell
|
| 8 |
-- identifer), a Haskell type, and an expression it matches. It also
|
| 3 | 9 |
data PGDefinition = PGDefinition
|
| 4 | 10 |
{ defName :: String
|
| 5 | 11 |
, defDelim :: Bool
|
| 6 | 12 |
, defType :: String
|
| 7 | |
, defRules :: [Expr]
|
| 13 |
, defRules :: Expr
|
| 8 | 14 |
} deriving (Eq, Show)
|
| 9 | 15 |
|
| 16 |
-- | The set of possible indentation modifiers
|
| 10 | 17 |
data Indent = IEq | IGE | IGt | IAny
|
| 11 | 18 |
deriving (Eq, Show)
|
| 12 | 19 |
|
| 20 |
type Pred = Char -> Bool
|
| 21 |
|
| 13 | 22 |
data Expr
|
| 14 | |
= ELiteral String
|
| 15 | |
| ECharset String
|
| 16 | |
| EChoice Expr Expr
|
| 17 | |
| ESequence Expr Expr
|
| 18 | |
| EAction Expr Code
|
| 19 | |
| EStar Expr
|
| 20 | |
| EPlus Expr
|
| 21 | |
| EQues Expr
|
| 22 | |
| EPred Bool Expr
|
| 23 | |
| EIndent Expr Indent
|
| 24 | |
| EBars Expr
|
| 23 |
= ELiteral String -- ^ Matches a literal string
|
| 24 |
| ECharset Pred -- ^ Matches a set of characters
|
| 25 |
| EChoice Expr Expr -- ^ Matches either the left or the right expr,
|
| 26 |
-- in that order
|
| 27 |
| ESequence Expr Expr -- ^ Matches both exprs in sequence
|
| 28 |
| EAction Expr String -- ^ Performs an action on the matched expr
|
| 29 |
| EStar Expr -- ^ Matches zero or more repetitions of the expr
|
| 30 |
| EQues Expr -- ^ Matches zero or one repetions of the expr
|
| 31 |
| EPred Bool Expr -- ^ Matches without consuming input if the
|
| 32 |
-- boolean is true and the expr matches; or if
|
| 33 |
-- the boolean is false and the expr fails
|
| 34 |
| EIndent Expr Indent -- ^ Specifies an indentation level for the expr,
|
| 35 |
-- and fails if it does not fall into that level
|
| 36 |
| EBars Expr -- ^ blah
|
| 37 |
| EAny -- ^ Matches any terminal
|
| 38 |
| ENamed -- ^ Matches a named terminal or non-terminal
|
| 25 | 39 |
deriving (Eq, Show)
|
| 40 |
|
| 41 |
newtype Parser a =
|
| 42 |
Parser { runParser :: String -> Either String (String, a) }
|
| 43 |
|
| 44 |
instance Functor Parser where
|
| 45 |
fmap f p = Parser $ \s -> case runParser p s of
|
| 46 |
Left err -> Left err
|
| 47 |
Right (s', a) -> Right (s', f a)
|
| 48 |
|
| 49 |
instance Applicative Parser where
|
| 50 |
pure a = Parser $ \ s -> Right (s, a)
|
| 51 |
f <*> x = Parser $ \ s -> do
|
| 52 |
(s', f') <- runParser f s
|
| 53 |
(s'', x') <- runParser x s'
|
| 54 |
return (s'', f' x')
|
| 55 |
|
| 56 |
instance Alternative Parser where
|
| 57 |
empty = Parser (\ _ -> Left "Parsing failed")
|
| 58 |
l <|> r = Parser $ \ s ->
|
| 59 |
case runParser l s of
|
| 60 |
Left _ -> runParser r s
|
| 61 |
Right x -> return x
|
| 62 |
|
| 63 |
instance Monad Parser where
|
| 64 |
return a = Parser $ \ s -> Right (s, a)
|
| 65 |
p >>= f = Parser $ \ s -> do
|
| 66 |
(s', x) <- runParser p s
|
| 67 |
runParser (f x) s'
|
| 68 |
|
| 69 |
(??) :: Parser a -> String -> Parser a
|
| 70 |
p ?? err = Parser $ \s -> case runParser p s of
|
| 71 |
Left _ -> Left err
|
| 72 |
Right x -> return x
|
| 73 |
|
| 74 |
satisfies :: (Char -> Bool) -> Parser Char
|
| 75 |
satisfies f = Parser $ \case
|
| 76 |
(x:xs)
|
| 77 |
| f x -> return (xs, x)
|
| 78 |
| otherwise -> Left ("in `satisfies`: did not satisfy predicate")
|
| 79 |
_ -> Left ("in `satisfies`: no more input")
|
| 80 |
|
| 81 |
char :: Char -> Parser Char
|
| 82 |
char c = satisfies (== c) ?? ("Did not match char " ++ show c)
|