console and graph packages split off.

makefile

@@ -4,7 +4,7 @@ tests:
 	(cd specs; runghc -i../src Specs)
 
 shell:
-	ghci -isrc -outputdir dist/build Prolog GraphViz Quote IsString -XOverloadedStrings -XQuasiQuotes
+	ghci -isrc -iprolog-graph -outputdir dist/build Prolog GraphViz Quote IsString -XOverloadedStrings -XQuasiQuotes
 
 bench:
 	( cd bench; \

prolog-console/Main.hs

@@ -0,0 +1,2 @@
+module Main (main) where
+import Console

prolog-console/prolog-console.cabal

@@ -0,0 +1,19 @@
+Name:                prolog-console
+Version:             0.1
+Synopsis:            A Prolog interpreter written in Haskell.
+License:             PublicDomain
+Author:              Matthias Bartsch
+Maintainer:          bartsch@cs.uni-bonn.de
+Category:            Language
+Build-type:          Simple
+
+Cabal-version:       >=1.2
+
+Executable hsprolog
+  Main-is: Main.hs
+
+  Build-depends:
+    base >=4 && <5,
+    parsec >= 3.1.1,
+    readline >= 1.0.1.0,
+    prolog == 0.1.*

src/GraphViz.hs → prolog-graph/GraphViz.hs

@@ -14,7 +14,11 @@ import Data.GraphViz (preview, runGraphviz, setDirectedness, graphToDot, Graphvi
 import Data.GraphViz.Attributes.Colors (Color(X11Color), X11Color(..))
 import Data.GraphViz.Attributes.HTML
 
-import Prolog
+import qualified Data.Text.Lazy
+
+import Language.Prolog
+
+htmlStr = HtmlStr . Data.Text.Lazy.pack
 
 
 -- Graphical output of derivation tree
@@ -64,11 +68,11 @@ ensureNode node label =
          then graph
          else Graph.insNode (node, label) graph
 
-makeNodeLabel _ [] = [HtmlStr "[]"]
-makeNodeLabel _ gs = [HtmlStr $ intercalate "," $ map show gs]
+makeNodeLabel _ [] = [htmlStr "[]"]
+makeNodeLabel _ gs = [htmlStr $ intercalate "," $ map show gs]
 
-makeEdgeLabel [] _ = [HtmlFont [HtmlPointSize 8] [HtmlStr "{}"]]
-makeEdgeLabel u  _ = [HtmlFont [HtmlPointSize 8] $ intersperse (HtmlNewline []) [HtmlStr $ show v ++ " = " ++ show t | (v,t) <- u]]
+makeEdgeLabel [] _ = [HtmlFont [HtmlPointSize 8] [htmlStr "{}"]]
+makeEdgeLabel u  _ = [HtmlFont [HtmlPointSize 8] $ intersperse (HtmlNewline []) [htmlStr $ show v ++ " = " ++ show t | (v,t) <- u]]
 
 modifyLabel node f = do
    modify $ Graph.gmap $ \cxt@(in_,node',label,out) ->

prolog-graph/Main.hs

@@ -0,0 +1,18 @@
+module Main where
+
+import Control.Applicative ((<$>))
+import Control.Arrow ((>>>),(<<<))
+import Language.Prolog (consult, parseQuery)
+import ParseArgs (parseArgs)
+import GraphViz (resolveTree, resolveTreeToFile)
+
+main = do
+   (queryString, files, output) <- parseArgs
+   p <- concat <$> mapM ((abortOnError=<<) . consult) files
+   q <- abortOnError $ parseQuery queryString
+   resolveTreeToFile output p q
+   --case output of
+   --   Nothing -> resolveTree p q {- FIXME Never shown since thread terminated. -}
+   --   Just file -> resolveTreeToFile file p q >> return ()
+
+abortOnError = either (error . show) return

prolog-graph/ParseArgs.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module ParseArgs (
+   parseArgs
+) where
+
+import System.Console.CmdArgs
+import System.Environment (getProgName)
+
+data Options = Options
+   { query :: String
+   , file  :: [String]
+   , output :: String
+   , positional :: [String]
+   }
+  deriving (Data, Typeable)
+
+options = Options
+  { query  = def &= typ "QUERY" &= help "Set Prolog query (If not set, first positional argument is used)"
+  , file   = def &= typ "FILE"  &= help "Consult file before executing query"
+  , output = "graph.png" &= typ "FILE"  &= help "Save generated image to file (default: 'graph.png')"
+  , positional = def &= args &= typ "QUERY [FILE]..."
+  }
+  &= versionArg [ignore]
+  &= helpArg [name "h"]
+
+parseArgs = do
+   opts <- getProgName >>= cmdArgs . ((options &=) . program)
+   return $ case opts of
+      Options q fs o []      -> (q, fs,      o)
+      Options _ fs o [q]     -> (q, fs,      o)
+      Options _ fs o (q:fs') -> (q, fs++fs', o)

prolog-graph/prolog-graph.cabal

@@ -0,0 +1,22 @@
+Name:                prolog-graph
+Version:             0.1
+Synopsis:            A Prolog interpreter written in Haskell.
+License:             PublicDomain
+Author:              Matthias Bartsch
+Maintainer:          bartsch@cs.uni-bonn.de
+Category:            Language
+Build-type:          Simple
+
+Cabal-version:       >=1.2
+
+Executable hsprolog-graph
+  Main-is: Main.hs
+
+  Build-depends:
+    base >=4 && <5,
+    prolog == 0.1.*,
+    fgl >= 5.4.2.4,
+    mtl >= 2.0.1.0,
+    cmdargs >= 0.8,
+    text >= 0.11.1.5,
+    graphviz

prolog.cabal

@@ -15,6 +15,7 @@ Library
                    Language.Prolog.Quote
   Other-modules:   Prolog
                    Interpreter
+                   Database
                    Unifier
                    Parser
                    Syntax

src/Parser.hs

@@ -1,5 +1,5 @@
 module Parser
-   ( consult
+   ( consult, parseQuery
    , program, whitespace, comment, clause, terms, term, bottom, vname
    ) where
 
@@ -17,6 +17,8 @@ consult = fmap consultString . readFile
 consultString :: String -> Either ParseError Program
 consultString = parse (whitespace >> program <* eof) "(input)"
 
+parseQuery = parse (whitespace >> terms <* eof) "(query)"
+
 program = many (clause <* char '.' <* whitespace)
 
 whitespace = skipMany (comment <|> skip space <?> "")

src/Prolog.hs

@@ -10,7 +10,7 @@ module Prolog
    , runNoGraphT
    , resolve, resolve_
    , (+++)
-   , consult
+   , consult, parseQuery
    , program, whitespace, comment, clause, terms, term, bottom, vname
    )
 where