summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/alloy/RunAlloy.classbin2734 -> 2737 bytes
-rw-r--r--call-alloy.cabal10
-rw-r--r--src/Language/Alloy/Call.hs41
3 files changed, 32 insertions, 19 deletions
diff --git a/bin/alloy/RunAlloy.class b/bin/alloy/RunAlloy.class
index b5e01c2..d8e2fce 100755
--- a/bin/alloy/RunAlloy.class
+++ b/bin/alloy/RunAlloy.class
Binary files differ
diff --git a/call-alloy.cabal b/call-alloy.cabal
index cf7c733..06640aa 100644
--- a/call-alloy.cabal
+++ b/call-alloy.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: dd057700e60aba8aee8cf2105303394e8c7934479b6057c438b6a3c423f514b4
+-- hash: 5f40f17f800e12b3cb98ac3b1383ac04a52cd1570b5329b12f3fffb03bdf46ab
name: call-alloy
-version: 0.2.0.1
+version: 0.2.0.3
synopsis: A simple library to call Alloy given a specification
description: Please see the README on GitHub at <https://github.com/marcellussiegburg/call-alloy#readme>
category: Language
@@ -55,14 +55,13 @@ library
, process >=1.6 && <1.7
, split >=0.2 && <0.3
, trifecta >=2 && <2.2
- , unix >=2.7 && <2.8
if os(windows)
cpp-options: -DWINDOWS
build-depends:
Win32
else
build-depends:
- unix
+ unix >=2.7 && <2.8
default-language: Haskell2010
test-suite call-alloy-test
@@ -96,12 +95,11 @@ test-suite call-alloy-test
, process >=1.6 && <1.7
, split >=0.2 && <0.3
, trifecta >=2 && <2.2
- , unix >=2.7 && <2.8
if os(windows)
cpp-options: -DWINDOWS
build-depends:
Win32
else
build-depends:
- unix
+ unix >=2.7 && <2.8
default-language: Haskell2010
diff --git a/src/Language/Alloy/Call.hs b/src/Language/Alloy/Call.hs
index 83b765e..15da31e 100644
--- a/src/Language/Alloy/Call.hs
+++ b/src/Language/Alloy/Call.hs
@@ -22,27 +22,31 @@ module Language.Alloy.Call (
import qualified Data.ByteString as BS
(hGetLine, intercalate, writeFile)
+import qualified Data.ByteString.Char8 as BS (unlines)
-import Control.Monad (unless)
+import Control.Concurrent
+ (forkIO, killThread, newEmptyMVar, putMVar, takeMVar)
import Control.Lens.Internal.ByteString (unpackStrict8)
+import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.Hashable (hash)
import Data.IORef (IORef, newIORef, readIORef)
import Data.List.Split (splitOn)
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe)
import System.Directory
(XdgDirectory (..), createDirectory, doesFileExist, doesDirectoryExist,
getTemporaryDirectory, getXdgDirectory)
import System.Directory.Internal (setFileMode)
import System.Directory.Internal.Prelude
(catch, isDoesNotExistError)
-import System.Environment (lookupEnv)
import System.Exit (ExitCode (..))
import System.FilePath
((</>), (<.>), searchPathSeparator, takeDirectory)
-import System.IO (hClose, hIsEOF, hPutStr)
+import System.IO
+ (BufferMode (..), hClose, hFlush, hIsEOF, hPutStr, hSetBuffering)
import System.IO.Unsafe (unsafePerformIO)
import System.Process
+ (CreateProcess (..), StdStream (..), createProcess, proc, waitForProcess)
#if defined(mingw32_HOST_OS)
import System.Win32.Info (getUserName)
#else
@@ -71,8 +75,8 @@ mclassPath = unsafePerformIO (newIORef Nothing)
{-|
This function may be used to get all model instances for a given Alloy
-specification. It calls Alloy via a Java interface and returns the raw instance
-answers as list of 'String's.
+specification. It calls Alloy via a Java interface and parses the raw instance
+answers before returning the resulting list of 'AlloyInstance's.
-}
getInstances
:: Maybe Integer
@@ -91,11 +95,17 @@ getInstances maxInstances content = do
std_in = CreatePipe,
std_err = CreatePipe
}
+ pout <- listenForOutput hout
+ perr <- listenForOutput herr
+ hSetBuffering hin NoBuffering
hPutStr hin content
+ hFlush hin
hClose hin
- printCallErrors herr
- instas <- printContentOnError ph `seq`
- fmap (BS.intercalate "\n") . drop 1 . splitOn [begin] <$> getWholeOutput hout
+ out <- getOutput pout
+ err <- getOutput perr
+ printContentOnError ph
+ unless (null err) $ fail $ unpackStrict8 $ BS.unlines err
+ let instas = fmap (BS.intercalate "\n") $ drop 1 $ splitOn [begin] out
return $ either (error . show) id . parseInstance <$> instas
where
begin :: ByteString
@@ -108,10 +118,15 @@ getInstances maxInstances content = do
printContentOnError ph = do
code <- waitForProcess ph
unless (code == ExitSuccess)
- $ fail $ "Failed parsing your file:\n" <> content
- printCallErrors err = do
- errors <- getWholeOutput err
- unless (null errors) $ fail $ unpackStrict8 $ BS.intercalate "\n" errors
+ $ fail $ "Failed parsing the Alloy code:\n" <> content
+ listenForOutput h = do
+ mvar <- newEmptyMVar
+ pid <- forkIO $ getWholeOutput h >>= putMVar mvar
+ return (pid, mvar)
+ getOutput (pid, mvar) = do
+ output <- takeMVar mvar
+ killThread pid
+ return output
{-|
Check if the class path was determined already, if so use it, otherwise call