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

import Data.Default.Class
import qualified Data.Text.Lazy.IO as TLIO
import System.IO
import System.IO.Temp
import qualified Numeric.Optimization.MIP.LPFile as LPFile
import qualified Numeric.Optimization.MIP.Base as MIP
import Numeric.Optimization.MIP.Solver.Base
import qualified Numeric.Optimization.MIP.Solution.HiGHS as HiGHSSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

-- | A solver instance for calling @highs@ command from [HiGHS](https://github.com/ERGO-Code/HiGHS).
--
-- Use 'highs' and record update syntax to modify its field.
data HiGHS
  = HiGHS
  { HiGHS -> String
highsPath :: String
  , HiGHS -> [String]
highsArgs :: [String]
  }

instance Default HiGHS where
  def :: HiGHS
def = HiGHS
highs

-- | Default value of t'HiGHS'
highs :: HiGHS
highs :: HiGHS
highs = String -> [String] -> HiGHS
HiGHS String
"highs" []

instance IsSolver HiGHS IO where
  solve' :: HiGHS
-> SolveOptions -> Problem Scientific -> IO (Solution Scientific)
solve' HiGHS
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
"highs.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
"highs.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

            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
"highs_options.txt" ((String -> Handle -> IO (Solution Scientific))
 -> IO (Solution Scientific))
-> (String -> Handle -> IO (Solution Scientific))
-> IO (Solution Scientific)
forall a b. (a -> b) -> a -> b
$ \String
fname3 Handle
h3 -> do
              -- XXX: HiGHS does not support multiple options files
              [String]
options_args <-
                case SolveOptions -> Maybe (Tol Scientific)
solveTol SolveOptions
opt of
                  Maybe (Tol Scientific)
Nothing -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                  Just Tol Scientific
tol -> do
                    Handle -> String -> IO ()
hPutStrLn Handle
h3 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"mip_feasibility_tolerance = " 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)
                    Handle -> String -> IO ()
hPutStrLn Handle
h3 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"primal_feasibility_tolerance = " 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)
                    Handle -> String -> IO ()
hPutStrLn Handle
h3 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"dual_feasibility_tolerance = " 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] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"--options_file", String
fname3]
              Handle -> IO ()
hClose Handle
h3

              let args :: [String]
args = HiGHS -> [String]
highsArgs HiGHS
solver [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                         [String
"--model_file", String
fname1, String
"--solution_file", String
fname2] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                         [String]
options_args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                         (case SolveOptions -> Maybe Double
solveTimeLimit SolveOptions
opt of
                            Maybe Double
Nothing -> []
                            Just Double
sec -> [String
"--time_limit", Double -> String
forall a. Show a => a -> String
show Double
sec])
                  onGetLine :: String -> IO ()
onGetLine String
s = 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 (HiGHS -> String
highsPath HiGHS
solver) [String]
args Maybe String
forall a. Maybe a
Nothing String
"" String -> IO ()
onGetLine String -> IO ()
onGetErrorLine
              String -> IO (Solution Scientific)
HiGHSSol.readFile String
fname2