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 Char Statement
stmtAtom = Atom <$> parse
  where
    parse = some $ parseIf "variable name" $ \char -> isAlphaNum char || char == '_'

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

stmtBinary :: Parser Char Statement
stmtBinary = do
  parseToken "("
  s1 <- stmt
  constructor <- parseConnective
  s2 <- stmt
  parseToken ")"
  return $ constructor s1 s2
  where
    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 Char 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