cabal

only doing this because Data.Set is not in the stdlib

lib/Logic/Statement/Eval.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TupleSections #-}
+
+module Logic.Statement.Eval where
+
+import Logic.Statement (Statement(..), atoms)
+
+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