{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solver.GurobiCl
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solver.GurobiCl
  ( GurobiCl (..)
  , gurobiCl
  ) where

import Data.Default.Class
import Data.IORef
import Data.List (isPrefixOf)
import qualified Data.Text.Lazy.IO as TLIO
import System.Exit
import System.IO
import System.IO.Temp
import qualified Numeric.Optimization.MIP.Base as MIP
import qualified Numeric.Optimization.MIP.LPFile as LPFile
import Numeric.Optimization.MIP.Solver.Base
import qualified Numeric.Optimization.MIP.Solution.Gurobi as GurobiSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

-- | A solver instance for calling @gurobi_cl@ command from [Gurobi Optimizer](https://www.gurobi.com/solutions/gurobi-optimizer/).
--
-- Use 'gurobiCl' and record update syntax to modify its field.
data GurobiCl
  = GurobiCl
  { GurobiCl -> String
gurobiClPath :: String
  , GurobiCl -> [String]
gurobiClArgs :: [String]
  }

instance Default GurobiCl where
  def :: GurobiCl
def = GurobiCl
gurobiCl

-- | Default value of t'GurobiCl'
gurobiCl :: GurobiCl
gurobiCl :: GurobiCl
gurobiCl = String -> [String] -> GurobiCl
GurobiCl String
"gurobi_cl" []

instance IsSolver GurobiCl IO where
  solve' :: GurobiCl
-> SolveOptions -> Problem Scientific -> IO (Solution Scientific)
solve' GurobiCl
solver SolveOptions
opt Problem Scientific
prob = do
    case FileOptions -> Problem Scientific -> Either String Text
LPFile.render FileOptions
forall a. Default a => a
def Problem Scientific
prob of
      Left String
err -> IOError -> IO (Solution Scientific)
forall a. IOError -> IO a
ioError (IOError -> IO (Solution Scientific))
-> IOError -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
err
      Right Text
lp -> do
        String
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"gurobi.lp" ((String -> Handle -> IO (Solution Scientific))
 -> IO (Solution Scientific))
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ \String
fname1 Handle
h1 -> do
          Handle -> Text -> IO ()
TLIO.hPutStr Handle
h1 Text
lp
          Handle -> IO ()
hClose Handle
h1
          String
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"gurobi.sol" ((String -> Handle -> IO (Solution Scientific))
 -> IO (Solution Scientific))
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ \String
fname2 Handle
h2 -> do
            Handle -> IO ()
hClose Handle
h2
            IORef Status
statusRef <- Status -> IO (IORef Status)
forall a. a -> IO (IORef a)
newIORef Status
MIP.StatusUnknown
            let args :: [String]
args = GurobiCl -> [String]
gurobiClArgs GurobiCl
solver
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"ResultFile=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname2]
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (case SolveOptions -> Maybe Double
solveTimeLimit SolveOptions
opt of
                          Maybe Double
Nothing -> []
                          Just Double
sec -> [String
"TimeLimit=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sec])
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (case SolveOptions -> Maybe (Tol Scientific)
solveTol SolveOptions
opt of
                          Maybe (Tol Scientific)
Nothing -> []
                          Just Tol Scientific
tol ->
                            [ String
"IntFeasTol=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show (Tol Scientific -> Scientific
forall r. Tol r -> r
MIP.integralityTol Tol Scientific
tol)
                            , String
"FeasibilityTol=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show (Tol Scientific -> Scientific
forall r. Tol r -> r
MIP.feasibilityTol Tol Scientific
tol)
                            , String
"OptimalityTol=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show (Tol Scientific -> Scientific
forall r. Tol r -> r
MIP.optimalityTol Tol Scientific
tol)
                            ])
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
fname1]
                onGetLine :: String -> IO ()
onGetLine String
s = do
                  case String
s of
                    -- "Time limit reached" -> writeIORef statusRef MIP.StatusUnknown
                    String
"Model is unbounded" -> IORef Status -> Status -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Status
statusRef Status
MIP.StatusUnbounded
                    String
"Model is infeasible" -> IORef Status -> Status -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Status
statusRef Status
MIP.StatusInfeasible
                    String
"Model is infeasible or unbounded" -> IORef Status -> Status -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Status
statusRef Status
MIP.StatusInfeasibleOrUnbounded
                    String
_ | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"Optimal solution found" String
s -> IORef Status -> Status -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Status
statusRef Status
MIP.StatusOptimal
                    String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  SolveOptions -> String -> IO ()
solveLogger SolveOptions
opt String
s
                onGetErrorLine :: String -> IO ()
onGetErrorLine = SolveOptions -> String -> IO ()
solveErrorLogger SolveOptions
opt
            ExitCode
exitcode <- String
-> [String]
-> Maybe String
-> String
-> (String -> IO ())
-> (String -> IO ())
-> IO ExitCode
runProcessWithOutputCallback (GurobiCl -> String
gurobiClPath GurobiCl
solver) [String]
args Maybe String
forall a. Maybe a
Nothing String
"" String -> IO ()
onGetLine String -> IO ()
onGetErrorLine
            case ExitCode
exitcode of
              ExitFailure Int
n -> IOError -> IO (Solution Scientific)
forall a. IOError -> IO a
ioError (IOError -> IO (Solution Scientific))
-> IOError -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"exit with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
              ExitCode
ExitSuccess -> do
                Status
status <- IORef Status -> IO Status
forall a. IORef a -> IO a
readIORef IORef Status
statusRef
                Solution Scientific
sol <- String -> IO (Solution Scientific)
GurobiSol.readFile String
fname2
                Solution Scientific -> IO (Solution Scientific)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Solution Scientific -> IO (Solution Scientific))
-> Solution Scientific -> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ Solution Scientific
sol{ MIP.solStatus = status }