FFI.hsc

{-# LANGUAGE ForeignFunctionInterface #-}
module Numeric.HiGHS.LP.FFI where

import qualified Foreign.Storable.Newtype as Store
import qualified Foreign.C.Types as C
import qualified Foreign.Storable as St
import Foreign.C.String (CString)
import Foreign.Storable (Storable)
import Foreign.Ptr (Ptr)

import Data.Int (Int32)

import Prelude hiding (Bool)


type CDouble = C.CDouble
type CInt = C.CInt


#include "interfaces/highs_c_api.h"

type HighsInt = #{type HighsInt}

newtype ObjSense = ObjSense HighsInt

objSenseMinimize, objSenseMaximize :: ObjSense
objSenseMinimize = ObjSense (#const kHighsObjSenseMinimize)
objSenseMaximize = ObjSense (#const kHighsObjSenseMaximize)

newtype MatrixFormat = MatrixFormat HighsInt

matrixFormatColwise, matrixFormatRowwise :: MatrixFormat
matrixFormatColwise = MatrixFormat (#const kHighsMatrixFormatColwise)
matrixFormatRowwise = MatrixFormat (#const kHighsMatrixFormatRowwise)

newtype Status = Status HighsInt
   deriving (Eq, Show)

statusError, statusOk, statusWarning :: Status
statusError   = Status (#const kHighsStatusError)
statusOk      = Status (#const kHighsStatusOk)
statusWarning = Status (#const kHighsStatusWarning)

newtype ModelStatus = ModelStatus {deModelStatus :: HighsInt}
   deriving (Eq, Show)

modelStatusNotset :: ModelStatus
modelStatusLoadError :: ModelStatus
modelStatusModelError :: ModelStatus
modelStatusPresolveError :: ModelStatus
modelStatusSolveError :: ModelStatus
modelStatusPostsolveError :: ModelStatus
modelStatusModelEmpty :: ModelStatus
modelStatusOptimal :: ModelStatus
modelStatusInfeasible :: ModelStatus
modelStatusUnboundedOrInfeasible :: ModelStatus
modelStatusUnbounded :: ModelStatus
modelStatusObjectiveBound :: ModelStatus
modelStatusObjectiveTarget :: ModelStatus
modelStatusTimeLimit :: ModelStatus
modelStatusIterationLimit :: ModelStatus
modelStatusUnknown :: ModelStatus
modelStatusSolutionLimit :: ModelStatus
modelStatusInterrupt :: ModelStatus

modelStatusNotset
   = ModelStatus (#const kHighsModelStatusNotset)
modelStatusLoadError
   = ModelStatus (#const kHighsModelStatusLoadError)
modelStatusModelError
   = ModelStatus (#const kHighsModelStatusModelError)
modelStatusPresolveError
   = ModelStatus (#const kHighsModelStatusPresolveError)
modelStatusSolveError
   = ModelStatus (#const kHighsModelStatusSolveError)
modelStatusPostsolveError
   = ModelStatus (#const kHighsModelStatusPostsolveError)
modelStatusModelEmpty
   = ModelStatus (#const kHighsModelStatusModelEmpty)
modelStatusOptimal
   = ModelStatus (#const kHighsModelStatusOptimal)
modelStatusInfeasible
   = ModelStatus (#const kHighsModelStatusInfeasible)
modelStatusUnboundedOrInfeasible
   = ModelStatus (#const kHighsModelStatusUnboundedOrInfeasible)
modelStatusUnbounded
   = ModelStatus (#const kHighsModelStatusUnbounded)
modelStatusObjectiveBound
   = ModelStatus (#const kHighsModelStatusObjectiveBound)
modelStatusObjectiveTarget
   = ModelStatus (#const kHighsModelStatusObjectiveTarget)
modelStatusTimeLimit
   = ModelStatus (#const kHighsModelStatusTimeLimit)
modelStatusIterationLimit
   = ModelStatus (#const kHighsModelStatusIterationLimit)
modelStatusUnknown
   = ModelStatus (#const kHighsModelStatusUnknown)
modelStatusSolutionLimit
   = ModelStatus (#const kHighsModelStatusSolutionLimit)
modelStatusInterrupt
   = ModelStatus (#const kHighsModelStatusInterrupt)

instance Storable ModelStatus where
   sizeOf = Store.sizeOf deModelStatus
   alignment = Store.alignment deModelStatus
   peek = Store.peek ModelStatus
   poke = Store.poke $ deModelStatus

newtype BasisStatus = BasisStatus {deBasisStatus :: HighsInt}

basisStatusLower, basisStatusBasic, basisStatusUpper,
   basisStatusZero, basisStatusNonbasic :: BasisStatus

basisStatusLower    = BasisStatus (#const kHighsBasisStatusLower)
basisStatusBasic    = BasisStatus (#const kHighsBasisStatusBasic)
basisStatusUpper    = BasisStatus (#const kHighsBasisStatusUpper)
basisStatusZero     = BasisStatus (#const kHighsBasisStatusZero)
basisStatusNonbasic = BasisStatus (#const kHighsBasisStatusNonbasic)

instance Show BasisStatus where
   show (BasisStatus status) =
      case status of
         (#const kHighsBasisStatusLower)    -> "Highs.basisStatusLower"
         (#const kHighsBasisStatusBasic)    -> "Highs.basisStatusBasic"
         (#const kHighsBasisStatusUpper)    -> "Highs.basisStatusUpper"
         (#const kHighsBasisStatusZero)     -> "Highs.basisStatusZero"
         (#const kHighsBasisStatusNonbasic) -> "Highs.basisStatusNonbasic"
         _ -> "(BasisStatus " ++ show status ++ ")"

instance Storable BasisStatus where
   sizeOf = Store.sizeOf deBasisStatus
   alignment = Store.alignment deBasisStatus
   peek = Store.peek BasisStatus
   poke = Store.poke deBasisStatus


foreign import ccall "Highs_lpCall"
   lpCall ::
      HighsInt -> HighsInt ->
      HighsInt -> MatrixFormat ->
      ObjSense ->
      CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr HighsInt -> Ptr HighsInt -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr BasisStatus ->
      Ptr BasisStatus ->
      Ptr ModelStatus ->
      IO Status


data Highs = Highs

foreign import ccall "Highs_create"
   create :: IO (Ptr Highs)

foreign import ccall "Highs_destroy"
   destroy :: Ptr Highs -> IO ()

foreign import ccall "Highs_run"
   run :: Ptr Highs -> IO Status

foreign import ccall "Highs_passLp"
   passLp ::
      Ptr Highs ->
      HighsInt -> HighsInt ->
      HighsInt -> MatrixFormat ->
      ObjSense ->
      CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr HighsInt -> Ptr HighsInt -> Ptr CDouble ->
      IO Status

foreign import ccall "Highs_getSolution"
   getSolution ::
      Ptr Highs ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      IO Status

foreign import ccall "Highs_getBasis"
   getBasis ::
      Ptr Highs ->
      Ptr BasisStatus ->
      Ptr BasisStatus ->
      IO Status

foreign import ccall "Highs_getModelStatus"
   getModelStatus :: Ptr Highs -> IO ModelStatus

foreign import ccall "Highs_getObjectiveValue"
   getObjectiveValue :: Ptr Highs -> IO CDouble


foreign import ccall "Highs_getNumCol"
   getNumCol :: Ptr highs -> IO HighsInt

foreign import ccall "Highs_getNumRow"
   getNumRow :: Ptr highs -> IO HighsInt


foreign import ccall "Highs_addRows"
   addRows ::
      Ptr Highs ->
      HighsInt ->
      Ptr CDouble -> Ptr CDouble ->
      HighsInt ->
      Ptr HighsInt -> Ptr HighsInt ->
      Ptr CDouble ->
      IO Status

foreign import ccall "Highs_changeObjectiveSense"
   changeObjectiveSense :: Ptr Highs -> ObjSense -> IO Status

foreign import ccall "Highs_changeObjectiveOffset"
   changeObjectiveOffset :: Ptr Highs -> CDouble -> IO Status

foreign import ccall "Highs_changeColsCostByRange"
   changeColsCostByRange ::
      Ptr Highs -> HighsInt -> HighsInt -> Ptr CDouble -> IO Status


foreign import ccall "Highs_readModel"
   readModel :: Ptr Highs -> CString -> IO Status

foreign import ccall "Highs_writeModel"
   writeModel :: Ptr Highs -> CString -> IO Status


newtype Bool = Bool HighsInt

false, true :: Bool
false = Bool 0
true  = Bool 1

foreign import ccall "Highs_setBoolOptionValue"
   setBoolOptionValue :: Ptr Highs -> CString -> Bool -> IO Status

foreign import ccall "Highs_setIntOptionValue"
   setIntOptionValue :: Ptr Highs -> CString -> HighsInt -> IO Status

foreign import ccall "Highs_setDoubleOptionValue"
   setDoubleOptionValue :: Ptr Highs -> CString -> CDouble -> IO Status

foreign import ccall "Highs_setStringOptionValue"
   setStringOptionValue :: Ptr Highs -> CString -> CString -> IO Status