Token.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecursiveDo #-}

module WAM.L0.Token where

import Control.Applicative
import Control.Applicative.Combinators
import Control.Monad
import Data.Char
import Text.Earley

data Token where
    Atom   :: String -> Token
    Var    :: String -> Token
    LPar   :: Token -- (
    RPar   :: Token -- )
    Query  :: Token -- ?-
    Comma  :: Token -- ,
    Period :: Token -- .
    deriving (Show, Eq)

tokens :: Grammar r (Prod r String Char [Token])
tokens = mdo
    atom 
        <-  rule $ Atom
        <$> liftA2 (:) (satisfy isLower) (many $ satisfy isAlphaNum)
        <*  ws
        <?> "atom"

    var 
        <-  rule $ Var
        <$> liftA2 (:) (satisfy isUpper) (many $ satisfy isAlphaNum)
        <*  ws
        <?> "variable"

    ws 
        <-  rule $ void
        <$> many (some (satisfy isSpace))
        <?> ""

    return (many (atom <|> var))