{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}

-- | A set of types and functions to help calling Minizinc as an external binary.
--
-- Current strategy is to use JSON encode/decoding for passing in inputs and
-- reading outputs.
-- At this time, only a primitive output parser is supported.
module Process.Minizinc
  ( MiniZinc (..),
    simpleMiniZinc,
    withArgs,
    Solver (..),
    SolverName,
    MilliSeconds,
    SearchState(..),
    result,
    ResultHandler(..),
    runMinizincJSON,
    collectResults,
    keepLast,
    runLastMinizincJSON,
    cleanTmpFile,
  )
where

import Control.Applicative ((<|>))
import Control.Exception (bracket)
import Data.Attoparsec.ByteString (Parser, parse, IResult(..))
import Data.Attoparsec.Combinator (try)
import Data.Aeson (FromJSON, fromJSON, ToJSON, encode, Value, Result(..))
import Data.Aeson.Parser.Internal (json')
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LByteString
import Data.Hashable (Hashable, hash)
import System.Directory (removeFile)
import System.Process (createProcess, proc, StdStream(CreatePipe), std_out, cleanupProcess)
import GHC.IO.Handle (Handle, hIsEOF)

-- | Type alias asking for milliseconds.
type MilliSeconds a = Int

-- | Name of a solver to be passed to the minizinc binary.
type SolverName = String

-- | Supported solvers or 'Other'.
data Solver = Chuffed | COIN_BC | CPLEX | Gecode | Gurobi | SCIP | Xpress | Other SolverName
  deriving (Int -> Solver -> ShowS
[Solver] -> ShowS
Solver -> String
(Int -> Solver -> ShowS)
-> (Solver -> String) -> ([Solver] -> ShowS) -> Show Solver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Solver] -> ShowS
$cshowList :: [Solver] -> ShowS
show :: Solver -> String
$cshow :: Solver -> String
showsPrec :: Int -> Solver -> ShowS
$cshowsPrec :: Int -> Solver -> ShowS
Show)

-- | An object helping to run MiniZinc.
data MiniZinc input answer
  = MiniZinc
      { -- | a file path to a model
        MiniZinc input answer -> String
model :: FilePath,
        -- | a file path to hold, must be writable and readable
        MiniZinc input answer -> input -> String
mkTmpDataPath :: input -> FilePath,
        -- | a timelimit in seconds (an Int)
        MiniZinc input answer -> input -> Int
mkTimeLimit :: input -> MilliSeconds Int,
        -- | the solver to use (see `minizinc --solvers`)
        MiniZinc input answer -> input -> Solver
mkSolver :: input -> Solver,
        -- | other arguments that get appended before the path to the model and data paths
        MiniZinc input answer -> input -> [String]
mkExtraArgs :: input -> [String]
      }

-- | Removes the temporary data file created as input before running minizinc.
cleanTmpFile :: MiniZinc input a -> input -> IO ()
cleanTmpFile :: MiniZinc input a -> input -> IO ()
cleanTmpFile mzn :: MiniZinc input a
mzn = String -> IO ()
removeFile (String -> IO ()) -> (input -> String) -> input -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MiniZinc input a -> input -> String
forall input answer. MiniZinc input answer -> input -> String
mkTmpDataPath MiniZinc input a
mzn

-- | A constructor for MiniZinc object for simple situations.
simpleMiniZinc ::
  Hashable input =>
  FilePath ->
  MilliSeconds Int ->
  Solver ->
  MiniZinc input answer
simpleMiniZinc :: String -> Int -> Solver -> MiniZinc input answer
simpleMiniZinc path :: String
path timeout :: Int
timeout solver :: Solver
solver =
  String
-> (input -> String)
-> (input -> Int)
-> (input -> Solver)
-> (input -> [String])
-> MiniZinc input answer
forall input answer.
String
-> (input -> String)
-> (input -> Int)
-> (input -> Solver)
-> (input -> [String])
-> MiniZinc input answer
MiniZinc
    String
path
    (\obj :: input
obj -> "minizinc-process-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (input -> Int
forall a. Hashable a => a -> Int
hash input
obj) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".json")
    (Int -> input -> Int
forall a b. a -> b -> a
const Int
timeout)
    (Solver -> input -> Solver
forall a b. a -> b -> a
const Solver
solver)
    ([String] -> input -> [String]
forall a b. a -> b -> a
const [])

-- | Helper to set arguments.
withArgs :: [String] -> MiniZinc input answer -> MiniZinc input answer
withArgs :: [String] -> MiniZinc input answer -> MiniZinc input answer
withArgs args :: [String]
args mzn :: MiniZinc input answer
mzn = MiniZinc input answer
mzn { mkExtraArgs :: input -> [String]
mkExtraArgs = [String] -> input -> [String]
forall a b. a -> b -> a
const [String]
args }

-- | Runs MiniZinc on the input and parses output for the last answer.
runLastMinizincJSON ::
  (ToJSON input, FromJSON answer) =>
  MiniZinc input answer ->
  input ->
  IO (Maybe answer)
runLastMinizincJSON :: MiniZinc input answer -> input -> IO (Maybe answer)
runLastMinizincJSON minizinc :: MiniZinc input answer
minizinc obj :: input
obj = do
  (Maybe (SearchState answer) -> Maybe answer)
-> IO (Maybe (SearchState answer)) -> IO (Maybe answer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (SearchState answer) -> Maybe answer
forall a. Maybe (SearchState a) -> Maybe a
adapt (IO (Maybe (SearchState answer)) -> IO (Maybe answer))
-> IO (Maybe (SearchState answer)) -> IO (Maybe answer)
forall a b. (a -> b) -> a -> b
$ MiniZinc input answer
-> input
-> Maybe (SearchState answer)
-> ResultHandler answer (Maybe (SearchState answer))
-> IO (Maybe (SearchState answer))
forall input answer b.
(ToJSON input, FromJSON answer) =>
MiniZinc input answer
-> input -> b -> ResultHandler answer b -> IO b
runMinizincJSON MiniZinc input answer
minizinc input
obj Maybe (SearchState answer)
forall a. Maybe a
Nothing ResultHandler answer (Maybe (SearchState answer))
forall obj. ResultHandler obj (Maybe (SearchState obj))
keepLast
  where
    adapt :: Maybe (SearchState a) -> Maybe a
    adapt :: Maybe (SearchState a) -> Maybe a
adapt x :: Maybe (SearchState a)
x = Maybe (SearchState a)
x Maybe (SearchState a) -> (SearchState a -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SearchState a -> Maybe a
forall a. SearchState a -> Maybe a
result

data SearchState a
  = Exhausted a
  | Incomplete a
  | Unsatisfiable
  | InternalError String
  deriving (Int -> SearchState a -> ShowS
[SearchState a] -> ShowS
SearchState a -> String
(Int -> SearchState a -> ShowS)
-> (SearchState a -> String)
-> ([SearchState a] -> ShowS)
-> Show (SearchState a)
forall a. Show a => Int -> SearchState a -> ShowS
forall a. Show a => [SearchState a] -> ShowS
forall a. Show a => SearchState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchState a] -> ShowS
$cshowList :: forall a. Show a => [SearchState a] -> ShowS
show :: SearchState a -> String
$cshow :: forall a. Show a => SearchState a -> String
showsPrec :: Int -> SearchState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SearchState a -> ShowS
Show, SearchState a -> SearchState a -> Bool
(SearchState a -> SearchState a -> Bool)
-> (SearchState a -> SearchState a -> Bool) -> Eq (SearchState a)
forall a. Eq a => SearchState a -> SearchState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchState a -> SearchState a -> Bool
$c/= :: forall a. Eq a => SearchState a -> SearchState a -> Bool
== :: SearchState a -> SearchState a -> Bool
$c== :: forall a. Eq a => SearchState a -> SearchState a -> Bool
Eq, Eq (SearchState a)
Eq (SearchState a) =>
(SearchState a -> SearchState a -> Ordering)
-> (SearchState a -> SearchState a -> Bool)
-> (SearchState a -> SearchState a -> Bool)
-> (SearchState a -> SearchState a -> Bool)
-> (SearchState a -> SearchState a -> Bool)
-> (SearchState a -> SearchState a -> SearchState a)
-> (SearchState a -> SearchState a -> SearchState a)
-> Ord (SearchState a)
SearchState a -> SearchState a -> Bool
SearchState a -> SearchState a -> Ordering
SearchState a -> SearchState a -> SearchState a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (SearchState a)
forall a. Ord a => SearchState a -> SearchState a -> Bool
forall a. Ord a => SearchState a -> SearchState a -> Ordering
forall a. Ord a => SearchState a -> SearchState a -> SearchState a
min :: SearchState a -> SearchState a -> SearchState a
$cmin :: forall a. Ord a => SearchState a -> SearchState a -> SearchState a
max :: SearchState a -> SearchState a -> SearchState a
$cmax :: forall a. Ord a => SearchState a -> SearchState a -> SearchState a
>= :: SearchState a -> SearchState a -> Bool
$c>= :: forall a. Ord a => SearchState a -> SearchState a -> Bool
> :: SearchState a -> SearchState a -> Bool
$c> :: forall a. Ord a => SearchState a -> SearchState a -> Bool
<= :: SearchState a -> SearchState a -> Bool
$c<= :: forall a. Ord a => SearchState a -> SearchState a -> Bool
< :: SearchState a -> SearchState a -> Bool
$c< :: forall a. Ord a => SearchState a -> SearchState a -> Bool
compare :: SearchState a -> SearchState a -> Ordering
$ccompare :: forall a. Ord a => SearchState a -> SearchState a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SearchState a)
Ord, a -> SearchState b -> SearchState a
(a -> b) -> SearchState a -> SearchState b
(forall a b. (a -> b) -> SearchState a -> SearchState b)
-> (forall a b. a -> SearchState b -> SearchState a)
-> Functor SearchState
forall a b. a -> SearchState b -> SearchState a
forall a b. (a -> b) -> SearchState a -> SearchState b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SearchState b -> SearchState a
$c<$ :: forall a b. a -> SearchState b -> SearchState a
fmap :: (a -> b) -> SearchState a -> SearchState b
$cfmap :: forall a b. (a -> b) -> SearchState a -> SearchState b
Functor)

result :: SearchState a -> Maybe a
result :: SearchState a -> Maybe a
result (Incomplete a :: a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
result (Exhausted a :: a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
result _ = Maybe a
forall a. Maybe a
Nothing

reduce :: FromJSON a => SearchState Value -> SearchState a
reduce :: SearchState Value -> SearchState a
reduce Unsatisfiable = SearchState a
forall a. SearchState a
Unsatisfiable
reduce (InternalError s :: String
s) = String -> SearchState a
forall a. String -> SearchState a
InternalError String
s
reduce (Exhausted val :: Value
val) = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
val of
  Success obj :: a
obj -> a -> SearchState a
forall a. a -> SearchState a
Exhausted a
obj
  Error err :: String
err -> String -> SearchState a
forall a. String -> SearchState a
InternalError String
err
reduce (Incomplete val :: Value
val) = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
val of
  Success obj :: a
obj -> a -> SearchState a
forall a. a -> SearchState a
Incomplete a
obj
  Error err :: String
err -> String -> SearchState a
forall a. String -> SearchState a
InternalError String
err

data ResultHandler obj b
  = ResultHandler
  { ResultHandler obj b
-> b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))
handleNext :: b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))
  }

-- | Collect all results in memory.
-- The resulting list is in reverse order (best are first elements in case of optimizations).
collectResults :: ResultHandler obj [SearchState obj]
collectResults :: ResultHandler obj [SearchState obj]
collectResults = ([SearchState obj]
 -> SearchState obj
 -> IO
      ([SearchState obj], Maybe (ResultHandler obj [SearchState obj])))
-> ResultHandler obj [SearchState obj]
forall obj b.
(b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b)))
-> ResultHandler obj b
ResultHandler [SearchState obj]
-> SearchState obj
-> IO
     ([SearchState obj], Maybe (ResultHandler obj [SearchState obj]))
forall (f :: * -> *) a obj.
Applicative f =>
[a] -> a -> f ([a], Maybe (ResultHandler obj [SearchState obj]))
go
  where
    go :: [a] -> a -> f ([a], Maybe (ResultHandler obj [SearchState obj]))
go xs :: [a]
xs x :: a
x = a
-> f ([a], Maybe (ResultHandler obj [SearchState obj]))
-> f ([a], Maybe (ResultHandler obj [SearchState obj]))
forall a b. a -> b -> b
seq a
x (f ([a], Maybe (ResultHandler obj [SearchState obj]))
 -> f ([a], Maybe (ResultHandler obj [SearchState obj])))
-> f ([a], Maybe (ResultHandler obj [SearchState obj]))
-> f ([a], Maybe (ResultHandler obj [SearchState obj]))
forall a b. (a -> b) -> a -> b
$ ([a], Maybe (ResultHandler obj [SearchState obj]))
-> f ([a], Maybe (ResultHandler obj [SearchState obj]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, ResultHandler obj [SearchState obj]
-> Maybe (ResultHandler obj [SearchState obj])
forall a. a -> Maybe a
Just (ResultHandler obj [SearchState obj]
 -> Maybe (ResultHandler obj [SearchState obj]))
-> ResultHandler obj [SearchState obj]
-> Maybe (ResultHandler obj [SearchState obj])
forall a b. (a -> b) -> a -> b
$ ResultHandler obj [SearchState obj]
forall obj. ResultHandler obj [SearchState obj]
collectResults)

-- | Keep only the latest result in memory.
keepLast :: ResultHandler obj (Maybe (SearchState obj))
keepLast :: ResultHandler obj (Maybe (SearchState obj))
keepLast = (Maybe (SearchState obj)
 -> SearchState obj
 -> IO
      (Maybe (SearchState obj),
       Maybe (ResultHandler obj (Maybe (SearchState obj)))))
-> ResultHandler obj (Maybe (SearchState obj))
forall obj b.
(b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b)))
-> ResultHandler obj b
ResultHandler Maybe (SearchState obj)
-> SearchState obj
-> IO
     (Maybe (SearchState obj),
      Maybe (ResultHandler obj (Maybe (SearchState obj))))
forall (f :: * -> *) p a obj.
Applicative f =>
p
-> a
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
go
  where
    go :: p
-> a
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
go _ x :: a
x = a
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
forall a b. a -> b -> b
seq a
x (f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
 -> f (Maybe a,
       Maybe (ResultHandler obj (Maybe (SearchState obj)))))
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
forall a b. (a -> b) -> a -> b
$ (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
-> f (Maybe a, Maybe (ResultHandler obj (Maybe (SearchState obj))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x, ResultHandler obj (Maybe (SearchState obj))
-> Maybe (ResultHandler obj (Maybe (SearchState obj)))
forall a. a -> Maybe a
Just (ResultHandler obj (Maybe (SearchState obj))
 -> Maybe (ResultHandler obj (Maybe (SearchState obj))))
-> ResultHandler obj (Maybe (SearchState obj))
-> Maybe (ResultHandler obj (Maybe (SearchState obj)))
forall a b. (a -> b) -> a -> b
$ ResultHandler obj (Maybe (SearchState obj))
forall obj. ResultHandler obj (Maybe (SearchState obj))
keepLast)


runMinizincJSON ::
  forall input answer b.
  (ToJSON input, FromJSON answer) =>
  MiniZinc input answer ->
  input ->
  b ->
  ResultHandler answer b ->
  IO b
runMinizincJSON :: MiniZinc input answer
-> input -> b -> ResultHandler answer b -> IO b
runMinizincJSON minizinc :: MiniZinc input answer
minizinc obj :: input
obj v0 :: b
v0 resultHandler :: ResultHandler answer b
resultHandler = do
  String -> ByteString -> IO ()
LByteString.writeFile String
fullPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ input -> ByteString
forall a. ToJSON a => a -> ByteString
encode input
obj
  let start :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
start = CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc "minizinc" [String]
args){ std_out :: StdStream
std_out = StdStream
CreatePipe }
  IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO b)
-> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
start
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess
    (\(_, Just out :: Handle
out, _, _) -> Handle
-> (ByteString -> IResult ByteString (SearchState Value))
-> ByteString
-> b
-> ResultHandler answer b
-> IO b
go Handle
out (Parser (SearchState Value)
-> ByteString -> IResult ByteString (SearchState Value)
forall a. Parser a -> ByteString -> Result a
parse Parser (SearchState Value)
oneResult) "" b
v0 ResultHandler answer b
resultHandler)
  where
    go :: Handle
       -> (ByteString -> IResult ByteString (SearchState Value))
       -> ByteString
       -> b
       -> ResultHandler answer b
       -> IO b
    go :: Handle
-> (ByteString -> IResult ByteString (SearchState Value))
-> ByteString
-> b
-> ResultHandler answer b
-> IO b
go out :: Handle
out parsebuf :: ByteString -> IResult ByteString (SearchState Value)
parsebuf buf :: ByteString
buf v1 :: b
v1 handler :: ResultHandler answer b
handler = do
           case ByteString -> IResult ByteString (SearchState Value)
parsebuf ByteString
buf of
             Done remainderBuf :: ByteString
remainderBuf stateVal :: SearchState Value
stateVal -> do
               (v2 :: b
v2, nextHandler :: Maybe (ResultHandler answer b)
nextHandler) <- (ResultHandler answer b
-> b
-> SearchState answer
-> IO (b, Maybe (ResultHandler answer b))
forall obj b.
ResultHandler obj b
-> b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))
handleNext ResultHandler answer b
handler) b
v1 (SearchState Value -> SearchState answer
forall a. FromJSON a => SearchState Value -> SearchState a
reduce SearchState Value
stateVal)
               case Maybe (ResultHandler answer b)
nextHandler of
                 Nothing -> b -> IO b
forall a. a -> IO a
userFinished b
v2
                 Just resultHandler :: ResultHandler answer b
resultHandler -> Handle
-> (ByteString -> IResult ByteString (SearchState Value))
-> ByteString
-> b
-> ResultHandler answer b
-> IO b
go Handle
out (Parser (SearchState Value)
-> ByteString -> IResult ByteString (SearchState Value)
forall a. Parser a -> ByteString -> Result a
parse Parser (SearchState Value)
oneResult) ByteString
remainderBuf b
v2 ResultHandler answer b
resultHandler
             Fail _ _ err :: String
err -> do
               (v2 :: b
v2,_) <- (ResultHandler answer b
-> b
-> SearchState answer
-> IO (b, Maybe (ResultHandler answer b))
forall obj b.
ResultHandler obj b
-> b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))
handleNext ResultHandler answer b
handler) b
v1 (String -> SearchState answer
forall a. String -> SearchState a
InternalError String
err)
               b -> IO b
forall a. a -> IO a
finalizeFailure b
v2
             Partial f :: ByteString -> IResult ByteString (SearchState Value)
f -> do
               -- NOTE: on End-Of-File we attempt to feed an empty byte to
               -- conclude the parse.
               -- Thus the real "final marked" is when the Handle is at EOF and
               -- the input chunk is empty.
               -- A more explicit final-result marker could benefit the
               -- implementation of ResultHandler.
               Bool
eof <- Handle -> IO Bool
hIsEOF Handle
out
               case (Bool
eof, ByteString -> Bool
ByteString.null ByteString
buf) of
                 (True, True) -> b -> IO b
forall a. a -> IO a
inputFinished b
v1
                 (True, False) -> Handle
-> (ByteString -> IResult ByteString (SearchState Value))
-> ByteString
-> b
-> ResultHandler answer b
-> IO b
go Handle
out ByteString -> IResult ByteString (SearchState Value)
f "" b
v1 ResultHandler answer b
handler
                 _             -> do
                     ByteString
dat <- Handle -> IO ByteString
ByteString.hGetLine Handle
out
                     Handle
-> (ByteString -> IResult ByteString (SearchState Value))
-> ByteString
-> b
-> ResultHandler answer b
-> IO b
go Handle
out ByteString -> IResult ByteString (SearchState Value)
f ByteString
dat b
v1 ResultHandler answer b
handler

    inputFinished :: a -> IO a
inputFinished = a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    userFinished :: a -> IO a
userFinished = a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    finalizeFailure :: a -> IO a
finalizeFailure = a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    fullPath :: FilePath
    fullPath :: String
fullPath = MiniZinc input answer -> input -> String
forall input answer. MiniZinc input answer -> input -> String
mkTmpDataPath MiniZinc input answer
minizinc input
obj
    args :: [String]
    args :: [String]
args =
      [ "--time-limit",
        Int -> String
forall a. Show a => a -> String
show (MiniZinc input answer -> input -> Int
forall input answer. MiniZinc input answer -> input -> Int
mkTimeLimit MiniZinc input answer
minizinc input
obj),
        "--solver",
        Solver -> String
showSolver (MiniZinc input answer -> input -> Solver
forall input answer. MiniZinc input answer -> input -> Solver
mkSolver MiniZinc input answer
minizinc input
obj),
        "--output-mode",
        "json"
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (MiniZinc input answer -> input -> [String]
forall input answer. MiniZinc input answer -> input -> [String]
mkExtraArgs MiniZinc input answer
minizinc input
obj)
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ MiniZinc input answer -> String
forall input answer. MiniZinc input answer -> String
model MiniZinc input answer
minizinc,
             String
fullPath
           ]

showSolver :: Solver -> String
showSolver :: Solver -> String
showSolver = \case
  Chuffed -> "Chuffed"
  COIN_BC -> "COIN-BC"
  CPLEX -> "CPLEX"
  Gecode -> "Gecode"
  Gurobi -> "Gurobi"
  SCIP -> "SCIP"
  Xpress -> "Xpress"
  Other n :: String
n -> String
n


-- | NOTE: the parser is fed with hGetLine (stripping EOL markers)
-- this assumption simplifies the grammar below
oneResult :: Parser (SearchState Value)
oneResult :: Parser (SearchState Value)
oneResult =
    Parser (SearchState Value) -> Parser (SearchState Value)
forall i a. Parser i a -> Parser i a
try Parser (SearchState Value)
forall a. Parser ByteString (SearchState a)
unsat
    Parser (SearchState Value)
-> Parser (SearchState Value) -> Parser (SearchState Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (SearchState Value)
sat
  where
    unsat :: Parser ByteString (SearchState a)
unsat =  Parser ByteString ByteString
unsatMark Parser ByteString ByteString
-> Parser ByteString (SearchState a)
-> Parser ByteString (SearchState a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SearchState a -> Parser ByteString (SearchState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchState a
forall a. SearchState a
Unsatisfiable

    sat :: Parser (SearchState Value)
sat = Value -> (Value -> SearchState Value) -> SearchState Value
forall t t. t -> (t -> t) -> t
reverseAp (Value -> (Value -> SearchState Value) -> SearchState Value)
-> Parser ByteString Value
-> Parser
     ByteString ((Value -> SearchState Value) -> SearchState Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Value
json' Parser
  ByteString ((Value -> SearchState Value) -> SearchState Value)
-> Parser ByteString (Value -> SearchState Value)
-> Parser (SearchState Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Value -> SearchState Value)
forall a. Parser ByteString (a -> SearchState a)
searchstate
    reverseAp :: t -> (t -> t) -> t
reverseAp val :: t
val constructor :: t -> t
constructor = t -> t
constructor t
val

    searchstate :: Parser ByteString (a -> SearchState a)
searchstate =
      Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString
resultMark Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
exhaustiveMark Parser ByteString ByteString
-> Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> SearchState a) -> Parser ByteString (a -> SearchState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> SearchState a
forall a. a -> SearchState a
Exhausted)
      Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
forall i a. Parser i a -> Parser i a
try (Parser ByteString ByteString
resultMark Parser ByteString ByteString
-> Parser ByteString (a -> SearchState a)
-> Parser ByteString (a -> SearchState a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> SearchState a) -> Parser ByteString (a -> SearchState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> SearchState a
forall a. a -> SearchState a
Incomplete)

    resultMark :: Parser ByteString ByteString
resultMark = "----------"
    exhaustiveMark :: Parser ByteString ByteString
exhaustiveMark = "=========="
    unsatMark :: Parser ByteString ByteString
unsatMark = "=====UNSATISFIABLE====="