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

import Prelude hiding (readFile, writeFile)

import qualified Data.Aeson as J
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Scientific (Scientific)
import qualified Data.Text as T
import GHC.Generics

import qualified Numeric.Optimization.MIP.Base as MIP
import Numeric.Optimization.MIP.Base (Solution (..))

data Incumbent
  = Incumbent
  { Incumbent -> Text
incumbentVersion :: T.Text
  , Incumbent -> Text
incumbentName :: T.Text
  , Incumbent -> Int
incumbentNumberOfVariables :: Int
  , Incumbent -> Bool
incumbentIsFoundFeasibleSolution :: Bool
  , Incumbent -> Scientific
incumbentObjective :: Scientific
  , Incumbent -> Scientific
incumbentTotalViolation :: Scientific
  , Incumbent -> Map Text Scientific
incumbentVariables :: Map T.Text Scientific
  , Incumbent -> Map Text Scientific
incumbentExpressions :: Map T.Text Scientific
  , Incumbent -> Map Text Scientific
incumbentConstraints :: Map T.Text Scientific
  , Incumbent -> Map Text Scientific
incumbentViolations :: Map T.Text Scientific
  }
  deriving ((forall x. Incumbent -> Rep Incumbent x)
-> (forall x. Rep Incumbent x -> Incumbent) -> Generic Incumbent
forall x. Rep Incumbent x -> Incumbent
forall x. Incumbent -> Rep Incumbent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Incumbent -> Rep Incumbent x
from :: forall x. Incumbent -> Rep Incumbent x
$cto :: forall x. Rep Incumbent x -> Incumbent
to :: forall x. Rep Incumbent x -> Incumbent
Generic, Int -> Incumbent -> ShowS
[Incumbent] -> ShowS
Incumbent -> String
(Int -> Incumbent -> ShowS)
-> (Incumbent -> String)
-> ([Incumbent] -> ShowS)
-> Show Incumbent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Incumbent -> ShowS
showsPrec :: Int -> Incumbent -> ShowS
$cshow :: Incumbent -> String
show :: Incumbent -> String
$cshowList :: [Incumbent] -> ShowS
showList :: [Incumbent] -> ShowS
Show)

customOptions :: J.Options
customOptions :: Options
customOptions =
  Options
J.defaultOptions
  { J.fieldLabelModifier = (J.camelTo2 '_' . drop (length "Incumbent"))
  }

instance J.FromJSON Incumbent where
  parseJSON :: Value -> Parser Incumbent
parseJSON = Options -> Value -> Parser Incumbent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
customOptions

readFile :: FilePath -> IO (MIP.Solution Scientific)
readFile :: String -> IO (Solution Scientific)
readFile String
fname = do
  Either String Incumbent
ret <- String -> IO (Either String Incumbent)
forall a. FromJSON a => String -> IO (Either String a)
J.eitherDecodeFileStrict' String
fname
  case Either String Incumbent
ret 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 Incumbent
incumbent -> 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
$
      MIP.Solution
      { solStatus :: Status
MIP.solStatus =
          if Incumbent -> Bool
incumbentIsFoundFeasibleSolution Incumbent
incumbent
          then Status
MIP.StatusFeasible
          else Status
MIP.StatusUnknown
      , solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue =
          Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Incumbent -> Scientific
incumbentObjective Incumbent
incumbent)
      , solVariables :: Map Var Scientific
MIP.solVariables =
          [(Var, Scientific)] -> Map Var Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text -> Var
MIP.Var Text
v, Scientific
val) | (Text
v, Scientific
val) <- Map Text Scientific -> [(Text, Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList (Incumbent -> Map Text Scientific
incumbentVariables Incumbent
incumbent)]
      }