{-# LINE 1 "src/Numeric/HiGHS/LP/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




type HighsInt = Int32
{-# LINE 23 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

newtype ObjSense = ObjSense HighsInt

objSenseMinimize, objSenseMaximize :: ObjSense
objSenseMinimize :: ObjSense
objSenseMinimize = HighsInt -> ObjSense
ObjSense (HighsInt
1)
{-# LINE 28 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
objSenseMaximize = ObjSense (-1)
{-# LINE 29 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

newtype MatrixFormat = MatrixFormat HighsInt

matrixFormatColwise, matrixFormatRowwise :: MatrixFormat
matrixFormatColwise :: MatrixFormat
matrixFormatColwise = HighsInt -> MatrixFormat
MatrixFormat (HighsInt
1)
{-# LINE 34 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
matrixFormatRowwise = MatrixFormat (2)
{-# LINE 35 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

newtype Status = Status HighsInt
   deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

statusError, statusOk, statusWarning :: Status
statusError :: Status
statusError   = HighsInt -> Status
Status (-HighsInt
1)
statusOk :: Status
{-# LINE 41 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
statusOk      = Status (0)
{-# LINE 42 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
statusWarning = Status (1)
{-# LINE 43 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

newtype ModelStatus = ModelStatus {ModelStatus -> HighsInt
deModelStatus :: HighsInt}
   deriving (ModelStatus -> ModelStatus -> Bool
(ModelStatus -> ModelStatus -> Bool)
-> (ModelStatus -> ModelStatus -> Bool) -> Eq ModelStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelStatus -> ModelStatus -> Bool
== :: ModelStatus -> ModelStatus -> Bool
$c/= :: ModelStatus -> ModelStatus -> Bool
/= :: ModelStatus -> ModelStatus -> Bool
Eq, Int -> ModelStatus -> ShowS
[ModelStatus] -> ShowS
ModelStatus -> String
(Int -> ModelStatus -> ShowS)
-> (ModelStatus -> String)
-> ([ModelStatus] -> ShowS)
-> Show ModelStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelStatus -> ShowS
showsPrec :: Int -> ModelStatus -> ShowS
$cshow :: ModelStatus -> String
show :: ModelStatus -> String
$cshowList :: [ModelStatus] -> ShowS
showList :: [ModelStatus] -> ShowS
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
modelStatusNotset
   = HighsInt -> ModelStatus
ModelStatus (HighsInt
0)
{-# LINE 68 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusLoadError
   = ModelStatus (1)
{-# LINE 70 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusModelError
   = ModelStatus (2)
{-# LINE 72 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusPresolveError
   = ModelStatus (3)
{-# LINE 74 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusSolveError
   = ModelStatus (4)
{-# LINE 76 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusPostsolveError
   = ModelStatus (5)
{-# LINE 78 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusModelEmpty
   = ModelStatus (6)
{-# LINE 80 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusOptimal
   = ModelStatus (7)
{-# LINE 82 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusInfeasible
   = ModelStatus (8)
{-# LINE 84 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusUnboundedOrInfeasible
   = ModelStatus (9)
{-# LINE 86 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusUnbounded
   = ModelStatus (10)
{-# LINE 88 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusObjectiveBound
   = ModelStatus (11)
{-# LINE 90 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusObjectiveTarget
   = ModelStatus (12)
{-# LINE 92 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusTimeLimit
   = ModelStatus (13)
{-# LINE 94 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusIterationLimit
   = ModelStatus (14)
{-# LINE 96 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusUnknown
   = ModelStatus (15)
{-# LINE 98 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusSolutionLimit
   = ModelStatus (16)
{-# LINE 100 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
modelStatusInterrupt
   = ModelStatus (17)
{-# LINE 102 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

instance Storable ModelStatus where
   sizeOf :: ModelStatus -> Int
sizeOf = (ModelStatus -> HighsInt) -> ModelStatus -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf ModelStatus -> HighsInt
deModelStatus
   alignment :: ModelStatus -> Int
alignment = (ModelStatus -> HighsInt) -> ModelStatus -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment ModelStatus -> HighsInt
deModelStatus
   peek :: Ptr ModelStatus -> IO ModelStatus
peek = (HighsInt -> ModelStatus) -> Ptr ModelStatus -> IO ModelStatus
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek HighsInt -> ModelStatus
ModelStatus
   poke :: Ptr ModelStatus -> ModelStatus -> IO ()
poke = (ModelStatus -> HighsInt)
-> Ptr ModelStatus -> ModelStatus -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke ((ModelStatus -> HighsInt)
 -> Ptr ModelStatus -> ModelStatus -> IO ())
-> (ModelStatus -> HighsInt)
-> Ptr ModelStatus
-> ModelStatus
-> IO ()
forall a b. (a -> b) -> a -> b
$ ModelStatus -> HighsInt
deModelStatus

newtype BasisStatus = BasisStatus {BasisStatus -> HighsInt
deBasisStatus :: HighsInt}

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

basisStatusLower :: BasisStatus
basisStatusLower    = HighsInt -> BasisStatus
BasisStatus (HighsInt
0)
{-# LINE 115 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
basisStatusBasic    = BasisStatus (1)
{-# LINE 116 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
basisStatusUpper    = BasisStatus (2)
{-# LINE 117 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
basisStatusZero     = BasisStatus (3)
{-# LINE 118 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
basisStatusNonbasic = BasisStatus (4)
{-# LINE 119 "src/Numeric/HiGHS/LP/FFI.hsc" #-}

instance Show BasisStatus where
   show :: BasisStatus -> String
show (BasisStatus HighsInt
status) =
      case HighsInt
status of
         (HighsInt
0)    -> String
"Highs.basisStatusLower"
{-# LINE 124 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
         (HighsInt
1)    -> String
"Highs.basisStatusBasic"
{-# LINE 125 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
         (HighsInt
2)    -> String
"Highs.basisStatusUpper"
{-# LINE 126 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
         (HighsInt
3)     -> String
"Highs.basisStatusZero"
{-# LINE 127 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
         (HighsInt
4) -> String
"Highs.basisStatusNonbasic"
{-# LINE 128 "src/Numeric/HiGHS/LP/FFI.hsc" #-}
         HighsInt
_ -> String
"(BasisStatus " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HighsInt -> String
forall a. Show a => a -> String
show HighsInt
status String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Storable BasisStatus where
   sizeOf :: BasisStatus -> Int
sizeOf = (BasisStatus -> HighsInt) -> BasisStatus -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf BasisStatus -> HighsInt
deBasisStatus
   alignment :: BasisStatus -> Int
alignment = (BasisStatus -> HighsInt) -> BasisStatus -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment BasisStatus -> HighsInt
deBasisStatus
   peek :: Ptr BasisStatus -> IO BasisStatus
peek = (HighsInt -> BasisStatus) -> Ptr BasisStatus -> IO BasisStatus
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek HighsInt -> BasisStatus
BasisStatus
   poke :: Ptr BasisStatus -> BasisStatus -> IO ()
poke = (BasisStatus -> HighsInt)
-> Ptr BasisStatus -> BasisStatus -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke BasisStatus -> HighsInt
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
false = HighsInt -> Bool
Bool HighsInt
0
true :: Bool
true  = HighsInt -> Bool
Bool HighsInt
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