{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Alloy.Internal.Call (
CallAlloyConfig (maxInstances, noOverflow, satSolver, timeout),
SatSolver (..),
defaultCallAlloyConfig,
getRawInstances,
getRawInstancesWith,
) where
import qualified Data.ByteString as BS (
intercalate,
stripPrefix,
)
import qualified Data.ByteString.Char8 as BS (
hGetLine,
putStrLn,
unlines,
)
import Control.Concurrent (
threadDelay,
)
import Control.Concurrent.Async (
concurrently,
mapConcurrently_,
wait,
withAsync
)
import Control.Concurrent.Extra (Lock, newLock, withLock)
import Control.Exception (IOException, bracket, catch)
import Control.Monad (unless, when)
import Control.Monad.Extra (whenJust)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (unpack)
import Data.IORef (
IORef,
atomicWriteIORef,
#ifdef mingw32_HOST_OS
newIORef,
#endif
readIORef,
)
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import System.Exit (ExitCode (..))
import System.FilePath
(searchPathSeparator)
import System.IO (
#ifndef mingw32_HOST_OS
BufferMode (..),
hSetBuffering,
#endif
Handle,
hClose,
hFlush,
hIsEOF,
hPutStr,
hPutStrLn,
stderr,
)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (
CreateProcess (..), StdStream (..), ProcessHandle,
cleanupProcess,
createProcess, proc, terminateProcess, waitForProcess,
)
import Language.Alloy.RessourceNames (
className,
classPackage,
)
import Language.Alloy.Ressources (
alloyJar,
commonsCliJar,
slf4jJar,
)
import Paths_call_alloy (getDataDir)
data SatSolver
= BerkMin
| Glucose
| Glucose41
| Lingeling
| MiniSat
| MiniSatProver
| PLingeling
| SAT4J
| Spear
deriving (SatSolver
SatSolver -> SatSolver -> Bounded SatSolver
forall a. a -> a -> Bounded a
$cminBound :: SatSolver
minBound :: SatSolver
$cmaxBound :: SatSolver
maxBound :: SatSolver
Bounded, Int -> SatSolver
SatSolver -> Int
SatSolver -> [SatSolver]
SatSolver -> SatSolver
SatSolver -> SatSolver -> [SatSolver]
SatSolver -> SatSolver -> SatSolver -> [SatSolver]
(SatSolver -> SatSolver)
-> (SatSolver -> SatSolver)
-> (Int -> SatSolver)
-> (SatSolver -> Int)
-> (SatSolver -> [SatSolver])
-> (SatSolver -> SatSolver -> [SatSolver])
-> (SatSolver -> SatSolver -> [SatSolver])
-> (SatSolver -> SatSolver -> SatSolver -> [SatSolver])
-> Enum SatSolver
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SatSolver -> SatSolver
succ :: SatSolver -> SatSolver
$cpred :: SatSolver -> SatSolver
pred :: SatSolver -> SatSolver
$ctoEnum :: Int -> SatSolver
toEnum :: Int -> SatSolver
$cfromEnum :: SatSolver -> Int
fromEnum :: SatSolver -> Int
$cenumFrom :: SatSolver -> [SatSolver]
enumFrom :: SatSolver -> [SatSolver]
$cenumFromThen :: SatSolver -> SatSolver -> [SatSolver]
enumFromThen :: SatSolver -> SatSolver -> [SatSolver]
$cenumFromTo :: SatSolver -> SatSolver -> [SatSolver]
enumFromTo :: SatSolver -> SatSolver -> [SatSolver]
$cenumFromThenTo :: SatSolver -> SatSolver -> SatSolver -> [SatSolver]
enumFromThenTo :: SatSolver -> SatSolver -> SatSolver -> [SatSolver]
Enum, SatSolver -> SatSolver -> Bool
(SatSolver -> SatSolver -> Bool)
-> (SatSolver -> SatSolver -> Bool) -> Eq SatSolver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SatSolver -> SatSolver -> Bool
== :: SatSolver -> SatSolver -> Bool
$c/= :: SatSolver -> SatSolver -> Bool
/= :: SatSolver -> SatSolver -> Bool
Eq, ReadPrec [SatSolver]
ReadPrec SatSolver
Int -> ReadS SatSolver
ReadS [SatSolver]
(Int -> ReadS SatSolver)
-> ReadS [SatSolver]
-> ReadPrec SatSolver
-> ReadPrec [SatSolver]
-> Read SatSolver
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SatSolver
readsPrec :: Int -> ReadS SatSolver
$creadList :: ReadS [SatSolver]
readList :: ReadS [SatSolver]
$creadPrec :: ReadPrec SatSolver
readPrec :: ReadPrec SatSolver
$creadListPrec :: ReadPrec [SatSolver]
readListPrec :: ReadPrec [SatSolver]
Read, Int -> SatSolver -> ShowS
[SatSolver] -> ShowS
SatSolver -> [Char]
(Int -> SatSolver -> ShowS)
-> (SatSolver -> [Char])
-> ([SatSolver] -> ShowS)
-> Show SatSolver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SatSolver -> ShowS
showsPrec :: Int -> SatSolver -> ShowS
$cshow :: SatSolver -> [Char]
show :: SatSolver -> [Char]
$cshowList :: [SatSolver] -> ShowS
showList :: [SatSolver] -> ShowS
Show)
toParameter :: SatSolver -> String
toParameter :: SatSolver -> [Char]
toParameter = \case
SatSolver
BerkMin -> [Char]
"BERKMIN"
SatSolver
Glucose -> [Char]
"GLUCOSE"
SatSolver
Glucose41 -> [Char]
"GLUCOSE41"
SatSolver
Lingeling -> [Char]
"LINGELING"
SatSolver
MiniSat -> [Char]
"MINISAT"
SatSolver
MiniSatProver -> [Char]
"MINISAT_PROVER"
SatSolver
PLingeling -> [Char]
"PLINGELING"
SatSolver
SAT4J -> [Char]
"SAT4J"
SatSolver
Spear -> [Char]
"SPEAR"
data CallAlloyConfig = CallAlloyConfig {
CallAlloyConfig -> Maybe Integer
maxInstances :: !(Maybe Integer),
CallAlloyConfig -> Bool
noOverflow :: !Bool,
CallAlloyConfig -> SatSolver
satSolver :: !SatSolver,
CallAlloyConfig -> Maybe Int
timeout :: !(Maybe Int)
}
defaultCallAlloyConfig :: CallAlloyConfig
defaultCallAlloyConfig :: CallAlloyConfig
defaultCallAlloyConfig = CallAlloyConfig {
maxInstances :: Maybe Integer
maxInstances = Maybe Integer
forall a. Maybe a
Nothing,
noOverflow :: Bool
noOverflow = Bool
True,
satSolver :: SatSolver
satSolver = SatSolver
SAT4J,
timeout :: Maybe Int
timeout = Maybe Int
forall a. Maybe a
Nothing
}
{-# NOINLINE outLock #-}
outLock :: Lock
outLock :: Lock
outLock = IO Lock -> Lock
forall a. IO a -> a
unsafePerformIO IO Lock
newLock
putOutLn :: String -> IO ()
putOutLn :: [Char] -> IO ()
putOutLn = Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
outLock (IO () -> IO ()) -> ([Char] -> IO ()) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn
putErrLn :: String -> IO ()
putErrLn :: [Char] -> IO ()
putErrLn = Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
outLock (IO () -> IO ()) -> ([Char] -> IO ()) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
getRawInstances
:: Maybe Integer
-> String
-> IO [ByteString]
getRawInstances :: Maybe Integer -> [Char] -> IO [ByteString]
getRawInstances Maybe Integer
maxIs = CallAlloyConfig -> [Char] -> IO [ByteString]
getRawInstancesWith CallAlloyConfig
defaultCallAlloyConfig {
maxInstances :: Maybe Integer
maxInstances = Maybe Integer
maxIs
}
callAlloyWith
:: CallAlloyConfig
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
callAlloyWith :: CallAlloyConfig
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
callAlloyWith CallAlloyConfig
config = do
[Char]
classPath <- IO [Char]
getClassPath
let callAlloy :: CreateProcess
callAlloy = [Char] -> [[Char]] -> CreateProcess
proc [Char]
"java"
([[Char]] -> CreateProcess) -> [[Char]] -> CreateProcess
forall a b. (a -> b) -> a -> b
$ [[Char]
"-cp", [Char]
classPath, [Char]
classPackage [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
className,
[Char]
"-i", Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> [Char]) -> Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ CallAlloyConfig -> Maybe Integer
maxInstances CallAlloyConfig
config]
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-o" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CallAlloyConfig -> Bool
noOverflow CallAlloyConfig
config]
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"-s", SatSolver -> [Char]
toParameter (CallAlloyConfig -> SatSolver
satSolver CallAlloyConfig
config)]
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
callAlloy {
std_out :: StdStream
std_out = StdStream
CreatePipe,
std_in :: StdStream
std_in = StdStream
CreatePipe,
std_err :: StdStream
std_err = StdStream
CreatePipe
}
getRawInstancesWith
:: CallAlloyConfig
-> String
-> IO [ByteString]
getRawInstancesWith :: CallAlloyConfig -> [Char] -> IO [ByteString]
getRawInstancesWith CallAlloyConfig
config [Char]
content
= IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO [ByteString])
-> IO [ByteString]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CallAlloyConfig
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
callAlloyWith CallAlloyConfig
config) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess (((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO [ByteString])
-> IO [ByteString])
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO [ByteString])
-> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
p -> do
(Just Handle
hin, Just Handle
hout, Just Handle
herr, ProcessHandle
ph) <- (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
p
#ifndef mingw32_HOST_OS
Handle -> BufferMode -> IO ()
hSetBuffering Handle
hin BufferMode
NoBuffering
let abort :: Maybe a
abort = Maybe a
forall a. Maybe a
Nothing
#else
abort <- Just <$> newIORef False
#endif
let evaluateAlloy' :: IO ()
evaluateAlloy' = do
Handle -> [Char] -> IO ()
hPutStr Handle
hin [Char]
content
Handle -> IO ()
hFlush Handle
hin
Handle -> IO ()
hClose Handle
hin
evaluateAlloy :: IO ()
evaluateAlloy = IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
evaluateAlloy' ((IOException -> IO ()) -> IO ())
-> (IOException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e -> do
let err :: [Char]
err = IOException -> [Char]
forall a. Show a => a -> [Char]
show (IOException
e :: IOException)
warn :: [Char]
warn = [Char]
"Maybe not complete instance was sent to Alloy "
explain :: [Char]
explain = [Char]
"(Are timeouts set? Make sure they are not too small!): "
[Char] -> IO ()
putErrLn ([Char]
"Warning: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
warn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
explain [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err)
Handle
-> Handle
-> Handle
-> ProcessHandle
-> Maybe (IORef Bool)
-> Maybe Int
-> IO [ByteString]
-> IO [ByteString]
forall a.
Handle
-> Handle
-> Handle
-> ProcessHandle
-> Maybe (IORef Bool)
-> Maybe Int
-> IO a
-> IO a
withTimeout Handle
hin Handle
hout Handle
herr ProcessHandle
ph Maybe (IORef Bool)
forall a. Maybe a
abort (CallAlloyConfig -> Maybe Int
timeout CallAlloyConfig
config) (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ do
([ByteString]
out, [ByteString]
err) <- (([ByteString], [ByteString]), ()) -> ([ByteString], [ByteString])
forall a b. (a, b) -> a
fst ((([ByteString], [ByteString]), ())
-> ([ByteString], [ByteString]))
-> IO (([ByteString], [ByteString]), ())
-> IO ([ByteString], [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ([ByteString], [ByteString])
-> IO () -> IO (([ByteString], [ByteString]), ())
forall a b. IO a -> IO b -> IO (a, b)
concurrently
(IO [ByteString]
-> IO [ByteString] -> IO ([ByteString], [ByteString])
forall a b. IO a -> IO b -> IO (a, b)
concurrently (Handle -> IO [ByteString]
getOutput Handle
hout) (Handle -> IO [ByteString]
getOutput Handle
herr))
IO ()
evaluateAlloy
[ByteString] -> Maybe (IORef Bool) -> ProcessHandle -> IO ()
printContentOnError [ByteString]
out Maybe (IORef Bool)
forall a. Maybe a
abort ProcessHandle
ph
let err' :: [ByteString]
err' = [ByteString] -> [ByteString]
removeInfoLines [ByteString]
err
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
err') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpack (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.unlines [ByteString]
err'
[ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ ([ByteString] -> ByteString) -> [[ByteString]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n")
([[ByteString]] -> [ByteString]) -> [[ByteString]] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ([ByteString] -> Bool) -> [[ByteString]] -> [[ByteString]]
forall {a}. (a -> Bool) -> [a] -> [a]
filterLast ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
partialInstance) (ByteString -> Bool)
-> ([ByteString] -> ByteString) -> [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
last)
([[ByteString]] -> [[ByteString]])
-> [[ByteString]] -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ Int -> [[ByteString]] -> [[ByteString]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[ByteString]] -> [[ByteString]])
-> [[ByteString]] -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString] -> [[ByteString]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [ByteString
begin] [ByteString]
out
where
begin :: ByteString
begin :: ByteString
begin = ByteString
"---INSTANCE---"
filterLast :: (a -> Bool) -> [a] -> [a]
filterLast a -> Bool
_ [] = []
filterLast a -> Bool
p x :: [a]
x@[a
_] = (a -> Bool) -> [a] -> [a]
forall {a}. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
x
filterLast a -> Bool
p (a
x:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> Bool) -> [a] -> [a]
filterLast a -> Bool
p [a]
xs
getOutput' :: Handle -> IO [ByteString]
getOutput' Handle
h = do
Bool
eof <- Handle -> IO Bool
hIsEOF Handle
h
if Bool
eof
then [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (:) (ByteString -> [ByteString] -> [ByteString])
-> IO ByteString -> IO ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BS.hGetLine Handle
h IO ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO [ByteString]
getOutput Handle
h
getOutput :: Handle -> IO [ByteString]
getOutput Handle
h = IO [ByteString]
-> (IOException -> IO [ByteString]) -> IO [ByteString]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(Handle -> IO [ByteString]
getOutput' Handle
h)
(\(IOException
_ :: IOException) -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
partialInstance])
printContentOnError :: [ByteString] -> Maybe (IORef Bool) -> ProcessHandle -> IO ()
printContentOnError [ByteString]
out Maybe (IORef Bool)
abort ProcessHandle
ph = do
ExitCode
code <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
Bool
aborted <- IO Bool -> (IORef Bool -> IO Bool) -> Maybe (IORef Bool) -> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef Maybe (IORef Bool)
abort
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ExitCode
ExitFailure Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
aborted)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putOutLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed parsing the Alloy code?:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
content
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ExitCode
ExitFailure Int
2 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
aborted)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
outLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.unlines [ByteString]
out
partialInstance :: ByteString
partialInstance :: ByteString
partialInstance = ByteString
"---PARTIAL_INSTANCE---"
removeInfoLines :: [ByteString] -> [ByteString]
removeInfoLines :: [ByteString] -> [ByteString]
removeInfoLines (ByteString
x:[ByteString]
xs)
| Just ByteString
_ <- ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix ByteString
"[main] INFO" ByteString
x
= [ByteString] -> [ByteString]
removeInfoLines [ByteString]
xs
| Just ByteString
_ <- ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix ByteString
"[main] WARN" ByteString
x
= [ByteString] -> [ByteString]
removeInfoLines [ByteString]
xs
| ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
partialInstance
= [ByteString] -> [ByteString]
removeInfoLines [ByteString]
xs
removeInfoLines [ByteString]
xs = [ByteString]
xs
withTimeout
:: Handle
-> Handle
-> Handle
-> ProcessHandle
-> Maybe (IORef Bool)
-> Maybe Int
-> IO a
-> IO a
withTimeout :: forall a.
Handle
-> Handle
-> Handle
-> ProcessHandle
-> Maybe (IORef Bool)
-> Maybe Int
-> IO a
-> IO a
withTimeout Handle
_ Handle
_ Handle
_ ProcessHandle
_ Maybe (IORef Bool)
_ Maybe Int
Nothing IO a
p = IO a
p
withTimeout Handle
i Handle
o Handle
e ProcessHandle
ph Maybe (IORef Bool)
abort (Just Int
t) IO a
p = IO a -> (Async a -> IO a) -> IO a
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO a
p ((Async a -> IO a) -> IO a) -> (Async a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Async a
a -> do
Int -> IO ()
threadDelay Int
t
Maybe (IORef Bool) -> (IORef Bool -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (IORef Bool)
abort (IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
`atomicWriteIORef` Bool
True)
(IO () -> IO ()) -> [IO ()] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ IO () -> IO ()
forall a. a -> a
id [
Handle -> IO ()
hClose Handle
e,
Handle -> IO ()
hClose Handle
o,
ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph
]
Handle -> IO ()
hClose Handle
i
Async a -> IO a
forall a. Async a -> IO a
wait Async a
a
getClassPath :: IO FilePath
getClassPath :: IO [Char]
getClassPath =
[Char] -> [Char] -> [Char] -> ShowS
concatPaths ([Char] -> [Char] -> [Char] -> ShowS)
-> IO [Char] -> IO ([Char] -> [Char] -> ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
getDataDir IO ([Char] -> [Char] -> ShowS) -> IO [Char] -> IO ([Char] -> ShowS)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [Char]
alloyJar IO ([Char] -> ShowS) -> IO [Char] -> IO ShowS
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [Char]
commonsCliJar IO ShowS -> IO [Char] -> IO [Char]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [Char]
slf4jJar
where
concatPaths :: [Char] -> [Char] -> [Char] -> ShowS
concatPaths [Char]
w [Char]
x [Char]
y [Char]
z = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
[Char
searchPathSeparator]
[[Char]
w, [Char]
x, [Char]
y, [Char]
z]