initial

.gitignore

@@ -0,0 +1 @@
+dist-newstyle/

README.md

@@ -0,0 +1,63 @@
+# infer
+
+is a simple inference engine. It’s inspired by [pgergis’ little
+library](https://github.com/pgergis/haskell-inferences). I built my version
+based on the initial description and realized I ended up with a super different
+internal solution and decided it was interesting enough to be kept around.
+
+For a problem description read the README of pgergis’ repo.
+
+## Example Usage
+
+Using the human/mortal syllogism we end up with the following interaction:
+
+```
+$ infer '[{"premises": ["mortal", "alive"], "conclusion": "will die"}, {"premises": ["human"], "conclusion": "mortal"}]' human alive
+Inferred the following statements: alive, human, mortal, will die
+```
+
+That seems right!
+
+As you can see, usage is a little different. Firstly, the premisses are not a
+list but instead use the rest of the arguments after the JSON-formatted rules
+list. Secondly we pretty-print the results a little.
+
+## How does it work?
+
+First we parse the JSON rules. Then we run `infer`, which will try and match
+the known premises against all the premises of the rules. If we find a match
+we insert it into the new known premises and discard the rule, since we know
+we don’t have to apply it anymore. We do this until trying to apply all the
+rules does not yield any new results.
+
+The code I’ve written is fairly terse, so here’s an annotated version of
+`infer`:
+
+```haskell
+-- pre are the known premises, env is the rule environment
+infer :: S.Set String -> [Rule] -> S.Set String
+infer pre env =
+  -- find will get us a tuple of found premises and the new set of rules
+  let (found, nenv) = find
+  -- if the new premises are nothing new we’re done
+  in if S.isSubsetOf found pre
+     then pre
+     -- otherwise we do it all over again with our new premises and env
+     else infer (S.union found pre) nenv
+  -- find goes over the environment, building a tuple of premises and
+  -- still applicable rules
+  where find = foldr mlook (S.empty, []) env
+        -- mlook gets a rule, the new found premises, and the new env
+        mlook r@Rule{premises, conclusion} (f, e) =
+          if S.isSubsetOf premises pre
+          -- if the premise matches, we add the conclusion and ignore the
+          -- rule, since we know it’s been applied
+          then (S.insert conclusion f, e)
+          -- otherwise we ignore the conclusion and add the rule for later
+          -- retesting
+          else (f, r:e)
+```
+
+<hr/>
+
+Have fun!

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

infer.cabal

@@ -0,0 +1,27 @@
+cabal-version:       >=1.10
+
+name:                infer
+version:             0.1.0.0
+license-file:        LICENSE
+author:              hellerve
+maintainer:          veit@veitheller.de
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+executable infer
+  main-is:             App.hs
+  build-depends:       base >=4.12.0.0 && <4.14.0.0
+                     , infer-lib
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+library infer-lib
+  ghc-options:         -Wall
+  exposed-modules:     Infer.Treat
+  build-depends:       base >=4.12.0.0 && <4.14.0.0
+                     , aeson
+                     , containers
+                     , utf8-string
+  hs-source-dirs:      lib
+  default-language:    Haskell2010
+

lib/Infer/Treat.hs

@@ -0,0 +1,33 @@
+{-# 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)

src/App.hs

@@ -0,0 +1,19 @@
+module Main where
+
+import Data.List (intercalate)
+import System.Environment (getArgs)
+import System.IO (hPutStrLn, stderr)
+
+import Infer.Treat (run)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  if length args < 2
+  then errln "Expected at least two arguments."
+  else
+    case run (head args) (tail args) of
+      Left e  -> errln e
+      Right v ->
+        putStrLn $ "Inferred the following statements: " ++ (intercalate ", " v)
+  where errln = hPutStrLn stderr