{-# LANGUAGE LambdaCase #-}

module Text.Puggle.AST where

import Control.Applicative

-- | A definition has a name (which must be a unique, valid Haskell
--   identifer), a Haskell type, and an expression it matches. It also
data PGDefinition = PGDefinition
  { defName  :: String
  , defDelim :: Bool
  , defType  :: String
  , defRules :: Expr
  } deriving (Eq, Show)

-- | The set of possible indentation modifiers
data Indent = IEq | IGE | IGt | IAny
  deriving (Eq, Show)

type Pred = Char -> Bool

data Expr
  = ELiteral String     -- ^ Matches a literal string
  | ECharset Pred       -- ^ Matches a set of characters
  | EChoice Expr Expr   -- ^ Matches either the left or the right expr,
                        --   in that order
  | ESequence Expr Expr -- ^ Matches both exprs in sequence
  | EAction Expr String -- ^ Performs an action on the matched expr
  | EStar Expr          -- ^ Matches zero or more repetitions of the expr
  | EQues Expr          -- ^ Matches zero or one repetions of the expr
  | EPred Bool Expr     -- ^ Matches without consuming input if the
                        --   boolean is true and the expr matches; or if
                        --   the boolean is false and the expr fails
  | EIndent Expr Indent -- ^ Specifies an indentation level for the expr,
                        --   and fails if it does not fall into that level
  | EBars Expr          -- ^ blah
  | EAny                -- ^ Matches any terminal
  | ENamed              -- ^ Matches a named terminal or non-terminal
    deriving (Eq, Show)

newtype Parser a =
  Parser { runParser :: String -> Either String (String, a) }

instance Functor Parser where
  fmap f p = Parser $ \s -> case runParser p s of
    Left err      -> Left err
    Right (s', a) -> Right (s', f a)

instance Applicative Parser where
  pure a = Parser $ \ s -> Right (s, a)
  f <*> x = Parser $ \ s -> do
    (s',  f') <- runParser f s
    (s'', x') <- runParser x s'
    return (s'', f' x')

instance Alternative Parser where
  empty = Parser (\ _ -> Left "Parsing failed")
  l <|> r = Parser $ \ s ->
    case runParser l s of
      Left _  -> runParser r s
      Right x -> return x

instance Monad Parser where
  return a = Parser $ \ s -> Right (s, a)
  p >>= f = Parser $ \ s -> do
    (s', x) <- runParser p s
    runParser (f x) s'

(??) :: Parser a -> String -> Parser a
p ?? err = Parser $ \s -> case runParser p s of
  Left _  -> Left err
  Right x -> return x

satisfies :: (Char -> Bool) -> Parser Char
satisfies f = Parser $ \case
  (x:xs)
    | f x       -> return (xs, x)
    | otherwise -> Left ("in `satisfies`: did not satisfy predicate")
  _             -> Left ("in `satisfies`: no more input")

char :: Char -> Parser Char
char c = satisfies (== c) ?? ("Did not match char " ++ show c)