satchmo-backends 1.8.1 → 1.8.2

raw patch · 2 files changed

+36/−20 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Satchmo/Solver/Minisat.hs +34/−19
• satchmo-backends.cabal +2/−1

@@ -18,15 +18,17 @@ -- import qualified Data.ByteString.Lazy as BS  import Data.Monoid-import System.IO (stderr, hFlush, hPutStrLn, hGetContents)+import System.IO (stderr, hFlush, hClose, hPutStrLn, hGetContents+       , hSetBuffering, BufferMode (..) ) import System.Process import Control.Monad ( when ) import Control.Concurrent import Control.Exception+import qualified Control.Exception as C  import qualified Data.Map as M -solve = using "minisat2"+solve = using "/usr/bin/minisat2"  using fp = Satchmo.Solve.solve $ minisat fp @@ -35,29 +37,42 @@     let header = mkDimacsHeader numVars numClauses         cs'    = BS.pack header `mappend` cs     let debug = False-    if False +    if debug        then BS.hPut stderr cs'        else hPutStrLn stderr header >> hFlush stderr +-- copied from+-- http://hackage.haskell.org/packages/archive/process/1.0.1.5/doc/html/src/System-Process.html#readProcessWithExitCode -    ( hin, hout, herr, proc ) <- -        System.Process.runInteractiveCommand-            $ unwords [ fp, "/dev/stdin", "/dev/stdout" ] +    ( Just inh, Just outh, Just errh, pid ) <- +       createProcess ( proc fp  [ "/dev/stdin", "/dev/stdout" ] )+           { std_in  = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } -    container <- newEmptyMVar-    forkIO $ do -        BS.hPut hin cs-        -- waitForProcess proc-        ds <- hGetContents hout-        hPutStrLn stderr $ unwords [ "output", "length", show ( length ds ) ]-        putMVar container ds+    outMVar <- newEmptyMVar -    out <- takeMVar container `Control.Exception.catch` \ ( _ :: AsyncException ) ->  do -        -- hPutStrLn stderr "got exception in waitForProcess"-        terminateProcess proc-        -- hPutStrLn stderr "terminateProcess done"-        return ""-    -- hPutStrLn stderr "end waitForProcess"+    -- fork off a thread to start consuming stdout+    out  <- hGetContents outh+    _ <- forkIO $ C.evaluate (length out) >> putMVar outMVar ()++    -- fork off a thread to start consuming stderr+    err  <- hGetContents errh+    _ <- forkIO $ C.evaluate (length err) >> putMVar outMVar ()++    -- now write and flush any input+    do BS.hPut  inh cs'; hFlush inh ; hClose inh -- done with stdin++    -- wait on the output+    takeMVar outMVar `Control.Exception.catch` \ ( _ :: AsyncException ) ->  do +        terminateProcess pid+    takeMVar outMVar `Control.Exception.catch` \ ( _ :: AsyncException ) ->  do +        terminateProcess pid+    hClose outh ; hClose errh++    -- wait on the process+    ex <- waitForProcess pid++    hPutStrLn stderr $ unwords [ "output", "length", show ( length out ) ]+    -- hPutStrLn stderr out      case lines out of         "SAT" : xs : _ -> do

@@ -1,5 +1,5 @@ Name:           satchmo-backends-Version:        1.8.1+Version:        1.8.2  License:        GPL License-file:	gpl-2.0.txt@@ -30,3 +30,4 @@     Other-modules:         Satchmo.Solver.Internal     hs-source-dirs:	.+