module Logic.Statement.Eval where

import Logic.Statement (Statement(..), atoms)

import Data.List (intercalate)
import Data.Either (fromRight)

data Bucket
  = Tautology
  | Contradiction
  | Contingent
  deriving (Eq, Show)

bucket :: Statement -> Bucket
bucket s
  | and values = Tautology
  | all not values = Contradiction
  | otherwise = Contingent
  where
    values = [fromRight undefined $ eval assignments s | assignments <- enumerate $ atoms s]

eval :: [(String, Bool)] -> Statement -> Either String Bool
eval assignments = aux
  where
    aux (Atom key)      = maybe (Left key) Right $ lookup key assignments
    aux (Not s)         = not <$> aux s
    aux (And s1 s2)     = (&&) <$> aux s1 <*> aux s2
    aux (Or s1 s2)      = (||) <$> aux s1 <*> aux s2
    aux (Implies s1 s2) = not <$> ((&&) <$> aux s1 <*> (not <$> aux s2))
    aux (Iff s1 s2)     = (==) <$> aux s1 <*> aux s2

enumerate :: [a] -> [[(a, Bool)]]
enumerate keys = map reverse $ aux start
  where
    aux assignments = (assignments:) $
      case next assignments of
        Nothing -> []
        Just (assignments') -> aux assignments'

    start = map (, False) keys

    next [] = Nothing
    next ((key, False):rest) = Just $ (key, True):rest
    next ((key, True):rest) = ((key, False):) <$> (next rest)

implies :: Bool -> Bool -> Bool
implies b1 b2 = not b1 || b2