module Logic.Statement.Parse where

import Logic.Parse
  ( Parser(..)
  , Input(..)
  , ParseError
  , expected
  , parseToken
  , parseIf
  )
import Logic.Statement (Statement(..))

import Control.Applicative (Alternative((<|>), some))
import Data.Char (isAlphaNum)

stmtAtom :: Parser Statement
stmtAtom = Atom <$> parse
  where
    parse = some $ parseIf "statement variable" $ \char -> isAlphaNum char || char == '_'

stmtNot :: Parser Statement
stmtNot = Not <$> (parseToken "!" *> stmt)

stmtBinary :: Parser Statement
stmtBinary = parseToken "(" *> body <* parseToken ")"
  where
    body = (\s1 f s2 -> f s1 s2) <$> stmt <*> parseConnective <*> stmt

    parseConnective =
      fmap (const And) (parseToken "&")
      <|> fmap (const Or) (parseToken "|")
      <|> fmap (const Implies) (parseToken "->")
      <|> fmap (const Iff) (parseToken "<->")
      <|> fail

    fail = Parser $ \input -> Left $ expected "connective" input

stmt :: Parser Statement
stmt = Parser $ \input ->
  let
    parser =
      case inputSeq input of
        [] -> fail
        ('!':_) -> stmtNot
        ('(':_) -> stmtBinary
        _ -> stmtAtom <|> fail
  in runParser parser input
  where
    fail = Parser $ \input -> Left $ expected "statement" input