34 lines
937 B
Haskell
34 lines
937 B
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Infer.Treat where
|
|
|
|
import Data.Aeson (ToJSON, FromJSON, eitherDecode)
|
|
import Data.ByteString.Lazy.UTF8 (fromString)
|
|
import GHC.Generics (Generic)
|
|
import qualified Data.Set as S
|
|
|
|
data Rule = Rule {
|
|
premises :: S.Set String,
|
|
conclusion :: String
|
|
}
|
|
deriving (Eq, Ord, Show, Generic)
|
|
|
|
instance ToJSON Rule
|
|
instance FromJSON Rule
|
|
|
|
run :: String -> [String] -> Either String [String]
|
|
run input pre = fmap f (eitherDecode $ fromString input)
|
|
where f = S.toList . infer (S.fromList pre)
|
|
|
|
infer :: S.Set String -> [Rule] -> S.Set String
|
|
infer pre env =
|
|
let (found, nenv) = find
|
|
in if S.isSubsetOf found pre
|
|
then pre
|
|
else infer (S.union found pre) nenv
|
|
where find = foldr mlook (S.empty, []) env
|
|
mlook r@Rule{premises, conclusion} (f, e) =
|
|
if S.isSubsetOf premises pre
|
|
then (S.insert conclusion f, e)
|
|
else (f, r:e)
|