{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Describes the basic structure of auctions and implements the
-- translation into a linear programme.  This does not include
-- features that require multiple LP runs, such as the TQSS.
module ProductMixAuction.LP.Core
  ( -- * Core auction representation
    Auction(..)
  , TotalSizeLimit(..)
  , mkAuction
  , defaultPreferences

  , auctionBidLabels
  , auctionGoodLabels
  , lookupBid
  , showAuction
  , mapAuction

    -- * Results
  , AuctionResult(..)
  , AVar(..)

    -- * Solving a single auction LP
  , runAuctionCore

    -- * Utilities
  , Goodly
  , AuctionException(..)

    -- * Lenses
  , auction_supply
  , auction_bids
  , auction_scale
  , auction_preferences
  , auction_constraints
  , auction_size_limit
  , auction_tweak_supply
  , auction_verbosity

  , ar_prices
  , ar_quantities
  , ar_normalised_price
  ) where

import Control.Exception
import Control.Lens hiding ((.=))
import Control.Monad
import Data.Aeson
import qualified Data.LinearProgram as LP
import Data.Default.Class
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import qualified System.IO.Silently as S
import Text.Read (readMaybe)

import ProductMixAuction.LP.AdditionalConstraint
import ProductMixAuction.LP.Bid
import ProductMixAuction.Supply
import ProductMixAuction.Types


-- | Errors that can be thrown when solving an auction
data AuctionException
    = GLPKFailed LP.ReturnCode
      -- ^ LP solver failed to produce a result, with the given return code
    | SupplyCurveDecreasing Good
      -- ^ Good with the given label has a decreasing supply curve
    | TQSSDecreasing
      -- ^ TQSS step function is decreasing
    | TQSSEmpty
       -- ^ TQSS has no steps
    | TQSSMinAboveMax Units Units
      -- ^ Lower bound of TQSS search exceeds upper bound
    | TQSSGoodMissing Good
      -- ^ Single-good TQSS refers to a good not in the auction
    | TQSSBadLambda
      -- ^ Non-vertical auction with a non-zero supply scale lambda
    | TQSSFirstStepNonZero
      -- ^ First TQSS step has a non-zero price
    | TQSSFirstStepTooSmall Units Units
      -- ^ First TQSS step smaller than initial auction size
    | TQSSNormalisedNotHorizontal
      -- ^ Normalised prices used with a non-horizontal TQSS
    | MaxProfitComplexBid
      -- ^ Maximising profitability used with a generalised or asymmetric bid
    | MaxProfitNotHorizontal
      -- ^ Maximising profitability used with a non-horizontal TQSS
    | MaxProfitTQSS
      -- ^ Maximising profitability used with a TQSS
    | MaxProfitNoSolution
      -- ^ No solution when maximising profitability
  deriving Show
instance Exception AuctionException where
  displayException e = case e of
    GLPKFailed r                   -> "GLPK failed: " ++ show r
    SupplyCurveDecreasing (G good) -> "Supply curve for good " ++ show good ++ " is decreasing"
    TQSSDecreasing                 -> "TQSS is decreasing"
    TQSSEmpty                      -> "TQSS is empty"
    TQSSMinAboveMax u1 u2          -> "Lower bound of TQSS search (" ++ show (_Units u1)
                                        ++ ") exceeds upper bound (" ++ show (_Units u2) ++ ")"
    TQSSGoodMissing (G good)       -> "TQSS refers to good " ++ show good ++ ", which is not defined in the auction"
    TQSSBadLambda                  -> "Supply scale lambda parameter must be zero for non-vertical auctions"
    TQSSFirstStepNonZero           -> "First TQSS step must have price zero"
    TQSSFirstStepTooSmall u1 u2    -> "First TQSS step width (" ++ show (_Units u1)
                                        ++ ") is strictly smaller than auction size (" ++ show (_Units u2) ++ ")"
    TQSSNormalisedNotHorizontal    -> "For a TQSS using normalised prices, only horizontal auctions are supported"
    MaxProfitComplexBid            -> "When maximising profitability, asymmetric or generalised bids are not supported"
    MaxProfitNotHorizontal         -> "When maximising profitability, only horizontal auctions are supported"
    MaxProfitTQSS                  -> "When maximising profitability, a TQSS cannot be used"
    MaxProfitNoSolution            -> "No solution found"
instance ToJSON AuctionException where
  toJSON e = object ["message" .= displayException e]



-- | Dump the LP to a file, if debug output is enabled.
debugDumpLP :: (Show v, Ord v, Real c) => Verbosity -> String -> LP.LP v c -> IO ()
debugDumpLP v fn lp = ifDebug v $ LP.writeLP fn lp

-- | Suppress output from the 'IO' action unless the debug flag is
-- set.  This is useful for invoking GLPK, because it doesn't appear
-- to make it possible to suppress all output otherwise.
silenceIfNotDebug :: Verbosity -> IO a -> IO a
silenceIfNotDebug v | v >= Debug = id
                    | otherwise  = S.silence


-- | Limit on the total quantity allocated by an auction, for use
-- implementing a TQSS.
data TotalSizeLimit
    = FixedLimit Units
      -- ^ Limit the total quantity allocated to a constant.
    | TQSSLimit [Step Units]
      -- ^ Limit the total quantity allocated by the given TQSS steps.


-- | Represents an auction that can be translated directly into a single run
-- of a linear program.
data Auction bid =
    Auction
        { _auction_supply      :: Supply Units
          -- ^ Seller's supply curves for the goods available in the auction.
        , _auction_bids        :: [Bid bid]
          -- ^ Bids from the bidders seeking goods from the auction.
        , _auction_scale       :: ScaleFactor
          -- ^ Scale factor to control precision with which allocations are calculated.
        , _auction_preferences :: [Good]
          -- ^ Goods listed in decreasing order of preference for selling
          -- them (i.e. the first list item is the most preferred), used to
          -- resolve ambiguity in quantities by tweaking the prices appearing
          -- in the objective function.  If a good is missing from the list,
          -- do not tweak its price at all.
        , _auction_constraints :: [AdditionalConstraint bid]
          -- ^ Additional linear constraints to impose on quantities
          -- allocated to bidders.
        , _auction_size_limit  :: Maybe TotalSizeLimit
          -- ^ If specified, a limit on the total allocation to steps
          -- on base goods.
        , _auction_tweak_supply :: Bool
          -- ^ Whether the quantities in the supply curves should be
          -- tweaked to ensure unique prices.
        , _auction_verbosity    :: Verbosity
          -- ^ Controls how much debug output is generated when
          -- solving the auction.
        }

$(makeLenses ''Auction)

-- | Smart constructor for auctions, given a description of the supply
-- curves and a list of bids, using sensible defaults for the other
-- fields.
mkAuction :: Supply Units -> [Bid bid] -> Auction bid
mkAuction supply bids =
    Auction { _auction_supply       = supply
            , _auction_bids         = bids
            , _auction_scale        = def
            , _auction_preferences  = defaultPreferences supply
            , _auction_constraints  = []
            , _auction_size_limit   = Nothing
            , _auction_tweak_supply = True
            , _auction_verbosity    = def
            }

-- | By default, the preference permutation for the supply lists the
-- goods in reverse order, so that the highest good is most preferred.
defaultPreferences :: Supply Units -> [Good]
defaultPreferences supply = reverse (supplyGoods supply)

-- | List labels of bids in the auction.
auctionBidLabels :: Auction bid -> [bid]
auctionBidLabels = map _bid_label . _auction_bids

-- | List labels of goods in the auction, in no particular order.
auctionGoodLabels :: Auction bid -> [Good]
auctionGoodLabels = supplyGoods . _auction_supply


-- | Look up a bid in the auction by its label.
lookupBid :: Eq bid => bid -> Auction bid -> Maybe (Bid bid)
lookupBid bid auction = find ((bid ==) . _bid_label) (_auction_bids auction)


-- | Render an auction in a vaugely human-readable format.
showAuction :: Show bid => Auction bid -> String
showAuction auction = unlines $ [ "GOODS"
                                , showSupply (_auction_supply auction)
                                , "BIDS"
                                ] ++ map showBid (_auction_bids auction)
                                  ++ ["", "CONSTRAINTS"]
                                  ++ map showConstraint (_auction_constraints auction)


-- | Change the representation of bid labels in an auction.  Requires the
-- codomain to have an 'Ord' instance, hence not a 'Functor'.
mapAuction :: Ord bid' => (bid -> bid') -> Auction bid -> Auction bid'
mapAuction f auction = auction { _auction_bids = map (fmap f) (_auction_bids auction)
                               , _auction_constraints = map (mapConstraint f) (_auction_constraints auction)
                               }


-- | Variables used in the linear program corresponding to an auction.
data AVar bid
  = AllocVar bid Good  -- ^ @x^i_j@, the amount of good @j@ allocated to bid @i@
  | ExtraAllocVar Good -- ^ @x^0_j@, the amount of good @j@ allocated to the "extra" bid
  | StepVar Good Int   -- ^ @y^q_j@, the amount of good @j@ allocated
                       -- using step @q@ of the supply curve
  | TQSSStepVar Int    -- ^ @t_l@, the total amount allocated using step @l@ of the TQSS
  deriving (Eq, Ord, Show)

-- | Constraints that must be satisfied by the bid label
-- types.
type Goodly x = (Ord x, Show x, Read x)

type AuctionLP bid = LP.LPM (AVar bid) Double ()

auctionLP :: Goodly bid => Auction bid -> AuctionLP bid
auctionLP auction0 = do
    LP.setDirection LP.Max
    LP.setObjective (auctionObjective auction)
    generalisedBidConstraints  auction
    bidConstraints             auction
    stepLengthConstraints      auction
    goodConsistencyConstraints auction
    additionalConstraints      auction0  -- Additional constraint uses untweaked supply size, see #186
    totalSizeConstraint        auction
  where
    auction | _auction_tweak_supply auction0 = auction0 & auction_supply %~ tweakSupply (_auction_scale auction0)
            | otherwise                      = auction0


-- | Tweak the supply curve by adding a small amount to the first step
-- of each curve.  This ensures that the auction will always determine
-- the lowest prices.
--
-- Let @eta = 1/(4*10^rho*N)@.  We tweak supply curve @j@ by @T_j eta@
-- where @T_j@ is one more than the number of goods above good @j@ in
-- the supply ordering.  Thus:
--
-- * for a vertical supply, we tweak supply curve @j@ by @(N+1-j)*eta@;
--
-- * for a horizontal supply, we tweak each supply curve by @eta@.
--
-- The total size constraint is then tweaked by
-- @2*N*eta = 1/(2*10^rho)@.
tweakSupply :: ScaleFactor -> Supply Units -> Supply Units
tweakSupply p s = over supply_curves (Map.mapWithKey tweak) s
  where
    n   = numSupplyCurves s
    eta = supplyTweakEta p n

    tweak :: Good -> SupplyCurveAndCover Units -> SupplyCurveAndCover Units
    tweak g = scac_curve.sc_steps %~ tweakSteps (fromIntegral (length (supplyGoodsAboveAll g s)) * eta)

-- | Tweak a list of steps by adding the given amount to the first
-- step (this is a no-op if there are no steps).
tweakSteps :: Num u => u -> [Step u] -> [Step u]
tweakSteps _ [] = []
tweakSteps x (step:steps) = (step & step_units +~ x) : steps

-- | Calculate @eta@, the value used when tweaking supply curve step
-- widths, given the scale factor and the number of goods in the
-- auction.
supplyTweakEta :: ScaleFactor -> Int -> Units
supplyTweakEta sf n = totalTweakEta sf / fromIntegral (2 * n)

-- | Calculate @2*N*eta@, the value used for tweaking the total
-- quantity available when using a TQSS.
totalTweakEta :: ScaleFactor -> Units
totalTweakEta (ScaleFactor p) =  1 / (2 * 10^p)


-- | The objective function for the LP:
--
-- > (sum_{i,j} (v^i_j + epsilon^{p_j+1}) x^i_j) - (sum_{j,q} mu^q_j y^q_j)
--
-- If a 'TQSSLimit' is in use, we subtract an extra term of
--
-- > sum_l nu_l t_l
--
-- where @nu_l@ is the height of the @l@th TQSS step and @t_l@ is a
-- variable for how much of this step is used.
auctionObjective :: Ord bid
                 => Auction bid
                 -> LP.LinFunc (AVar bid) Double
auctionObjective auction = LP.linCombination (xs ++ xs') LP.- LP.linCombination (ys ++ ys')
  where
    xs = [ (tweakPrice good (bidValue bid good), AllocVar (bid ^. bid_label) good)
         | bid <- _auction_bids auction
         , good <- auctionGoodLabels auction
         , bidValue bid good > 0
         ]
    xs' | auction ^. auction_tweak_supply
                    = [ (extraBidPrice, ExtraAllocVar good)
                      | good <- auctionGoodLabels auction
                      ]
        | otherwise = []

    -- Price for the "extra" bids: these must be larger than all
    -- possible normal bid prices.  Previously we used
    -- @maxBound :: Price@, but this leads to test failures with
    -- GLPK-4.63 (see #95).
    extraBidPrice = maybe 1 ((2 *) . _TweakedPrice) $
                      maximumOf (auction_bids.traverse.bid_values.traverse.bv_price) auction

    -- Preferences are represented as a list of goods in descending
    -- order of preference, so we add epsilon^2 to the first element
    -- and epsilon^(n+1) to the nth element (note that 'elemIndex'
    -- returns a 0-based index).  If a good is missing from the list,
    -- we add nothing at all.  Thus an empty list of preferences
    -- causes price tweaks to be disabled.
    epsilon = 1/2
    tweakPrice good v = tweakedPriceToDouble v + maybe 0 (epsilon ^) (preferenceIndex good)
    preferenceIndex good = (2 +) <$> elemIndex good (_auction_preferences auction)

    ys = [ (fromIntegral (step ^. step_price), StepVar good q)
         | (good, sc) <- listSupplyCurves (auction ^. auction_supply)
         , (q, step) <- unpackSupplyCurve sc
         ]

    ys' = case auction ^. auction_size_limit of
            Just (TQSSLimit ss) -> [ (fromIntegral (s ^. step_price), TQSSStepVar l) | (l, s) <- zip [1..] ss ]
            _                   -> []


-- | Impose the generalised bid constraints:
--
-- > forall i j . 0 <= a^i_j x^i_j <= kappa^i_j
generalisedBidConstraints :: (Ord bid, Show bid) => Auction bid -> AuctionLP bid
generalisedBidConstraints auction = mapM_ f xs
  where
    -- Small but significant optimization: if the trade-off coefficent
    -- is 1 (the common case), use 'LP.varBds' rather than 'LP.leqTo'
    -- as the former is much more efficient.
    f (i, j, a, kappa)
      | a == 1    = LP.varBds x 0 kappa
      | otherwise = do LP.varGeq x 0
                       LP.leqTo' ("generalisedBidConstraint " ++ show i ++ " " ++ show j)
                                 (LP.linCombination [(a, x)]) kappa
      where x = AllocVar i j

    -- All the bid and good labels in the auction, with their trade-offs
    -- and upper bounds (the lower bounds are all zero).  We do not
    -- include allocation variables where the bid's value is zero, in
    -- order to keep the LP smaller (and hence faster to solve).
    xs = [ (bid ^. bid_label, good, tradeOffToDouble (bidFraction bid good), unitsToDouble (bidQuantityOf bid good))
         | bid <- _auction_bids auction
         , good <- auctionGoodLabels auction
         , bidValue bid good > 0
         ]

bidConstraints :: (Ord bid, Show bid) => Auction bid -> AuctionLP bid
bidConstraints auction = do mapM_ (bidConstraint goods) (_auction_bids auction)
                            when (auction ^. auction_tweak_supply) $
                                 mapM_ (extraBidConstraint (auction ^. auction_scale) n) goods
  where
    goods = auctionGoodLabels auction
    n     = length goods

-- | Impose the constraint for the total quantity of goods allocated to this bid:
--
-- > sum_j a^i_j x^i_j <= k_i
--
-- where @a^i_j@ is the 'bidFraction' for asymmetric bids, @x^i_j@ is
-- the allocation variable and @k_i@ is the 'bid_quantity'.
bidConstraint :: (Ord bid, Show bid) => [Good] -> Bid bid -> AuctionLP bid
bidConstraint goods bid = LP.leqTo' ("bidConstraint " ++ show (bid ^. bid_label))
                                    (LP.linCombination xs)
                                    (unitsToDouble (bid ^. bid_quantity))
  where
    xs = [ (tradeOffToDouble (bidFraction bid good), AllocVar (bid ^. bid_label) good)
         | good <- goods
         , bidValue bid good > 0
         ]

-- | Bid constraint for the "extra" bid on good @j@, which is a single bid on
-- the good for @eta/2@ units, so the constraint is:
--
-- > x^0_j <= eta/2
extraBidConstraint :: Ord bid => ScaleFactor -> Int -> Good -> AuctionLP bid
extraBidConstraint p n good = LP.varBds (ExtraAllocVar good) 0 (eta/2)
  where
    eta = unitsToDouble (supplyTweakEta p n)

-- | Impose the step length constraints, which require the amount supplied
-- at each step to be bounded by the width of the step:
--
-- > forall j q . 0 <= y^q_j <= \hat{s}^q_j
stepLengthConstraints :: Ord bid => Auction bid -> AuctionLP bid
stepLengthConstraints auction =
    mapM_ (\ (good, sc) -> mapM_ (stepLengthConstraint good) (unpackSupplyCurve sc))
          (listSupplyCurves supply)
  where
    supply = _auction_supply auction

    stepLengthConstraint good (q, step) = case step ^. step_units of
      Nothing                                -> LP.varGeq (StepVar good q) 0
      Just u | explicitStepLengthConstraints -> do LP.varGeq (StepVar good q) 0
                                                   LP.leqTo' ("stepLengthConstraint " ++ show good ++ "_" ++ show q)
                                                              (LP.linCombination [(1, StepVar good q)])
                                                              (unitsToDouble u)
             | otherwise                     -> LP.varBds (StepVar good q) 0 (unitsToDouble u)


-- | Impose the good consistency constraints, which require that the
-- total allocated to bids for each good should be bounded by the
-- total available from the supply steps used:
--
-- > forall j . sum_i x^i_j <= (sum_q y^q_j) - (sum_{j' covers j} sum_q y^q_j')
--
-- For a vertical auction of goods j from 1 to N:
--
-- >                sum_i x^i_N <= sum_q y^q_N
-- > forall j < N . sum_i x^i_j <= (sum_q y^q_j) - (sum_q y^q_{j+1})
--
-- For a horizontal auction:
--
-- > forall j . sum_i x^i_j <= sum_q y^q_j
goodConsistencyConstraints :: Ord bid
                          => Auction bid -> AuctionLP bid
goodConsistencyConstraints auction = mapM_ help (Map.toList (_supply_curves supply))
  where
    supply = auction ^. auction_supply

    help (good, SupplyCurveAndCover sc covers) =
      LP.leq' (goodConsistencyConstraintLabel ++ " " ++ show good)
              (LP.linCombination (xs++xs'))
              (LP.linCombination ys1 LP.- LP.linCombination ys2)
      where
        xs  = [ (1, AllocVar (bid ^. bid_label) good) | bid <- auction ^. auction_bids, bidValue bid good > 0 ]
        xs' | auction ^. auction_tweak_supply = [(1, ExtraAllocVar good)]
            | otherwise                       = []
        ys1 = [ (1, StepVar good q)    | (q, _) <- unpackSupplyCurve sc ]
        ys2 = [ (1, StepVar good' q)   | good' <- covers
                                       , let sc' = lookupSupplyCurve good' supply
                                       , (q, _) <- unpackSupplyCurve sc' ]


-- | Impose additional linear constraints on the bids, each of which
-- is of the form:
--
-- > sum_{i,j} c^i_j x^i_j <= C R + C'
additionalConstraints :: Ord bid => Auction bid -> AuctionLP bid
additionalConstraints auction = mapM_ (additionalConstraint auction) (zip [1..] (_auction_constraints auction))

additionalConstraint :: Ord bid => Auction bid -> (Int, AdditionalConstraint bid) -> AuctionLP bid
additionalConstraint auction (i, ac) = LP.leqTo' ("additionalConstraint " ++ show i) lhs rhs
  where
    lhs = LP.linCombination [ (c, AllocVar b good)
                            | (b, m) <- Map.toList (_ac_coefficients ac)
                            , (good, c) <- Map.toList m
                            , Just bid <- [lookupBid b auction]
                            , bidValue bid good > 0
                            ]
    rhs = _Ratio (_ac_c ac) * _Units (totalSupply (_auction_supply auction)) + _ac_c' ac


-- | If an auction size limit is specified, impose a constraint that
-- limits the total quantity of goods supplied by the auction
-- (i.e. the sum of the base supply curve steps used).
--
-- When a @'FixedLimit' R@ is being used, this adds a constraint:
--
-- > sum_{j base good} sum_q y^q_j <= R + 2*N*eta
--
-- For a vertical auction:
--
-- > sum_q y^q_1 <= R + 2*N*eta
--
-- For a horizontal auction:
--
-- > sum_j sum_q y^q_j <= R + 2*N*eta
--
-- When a 'TQSSLimit' is being used, this instead adds a constraint:
--
-- > sum_{j base good} sum_q y^q_j <= sum_l t_l
--
-- where each @t_l@ is a variable bounded by the width of the
-- corresponding TQSS step, and the first step is tweaked (increased
-- in width) by @2*N*eta@.
totalSizeConstraint :: Ord bid => Auction bid -> AuctionLP bid
totalSizeConstraint auction = case auction ^. auction_size_limit of
    Nothing             -> return ()
    Just (FixedLimit r) -> LP.leqTo' "totalSizeConstraint" lhs (_Units (r + tweak))
    Just (TQSSLimit ss) -> do let ss' = tweakSteps tweak ss
                              mapM_ (\ (l, s) -> LP.varBds (TQSSStepVar l) 0 (unitsToDouble (s ^. step_units))) (zip [1..] ss')
                              LP.leq' tqssConstraintLabel lhs (tqss_rhs ss')
  where
    supply = auction ^. auction_supply
    lhs = LP.linCombination [ (1, StepVar good q)
                            | (good, sc) <- listSupplyCurves supply
                            , isFirstGood good supply
                            , (q, _) <- unpackSupplyCurve sc
                            ]
    tqss_rhs ss = LP.linCombination [ (1, TQSSStepVar l) | l <- [1..length ss] ]

    tweak | auction ^. auction_tweak_supply = totalTweakEta (auction ^. auction_scale)
          | otherwise                       = 0

-- | Results from a single run of the LP, including a price for each
-- good and a quantity value for each primal variable.
data AuctionResult bid =
    AuctionResult { _ar_prices     :: Map.Map Good Price
                    -- ^ Prices for the goods (values of the dual variables @z_j@)
                  , _ar_quantities :: Map.Map (AVar bid) Units
                    -- ^ Quantities assigned to the primal variables (@x^i_j@ and @y^q_j@)
                  , _ar_normalised_price :: Maybe Price
                    -- ^ Normalised price, if a normalised TQSS is in use
                  }
  deriving Show

-- | Convert the auction description to a linear program, solve it
-- using GLPK and return the results.
runAuctionCore :: Goodly bid => String -> Auction bid -> IO (AuctionResult bid)
runAuctionCore debug_fn auction = do
    let lp = LP.execLPM (auctionLP auction)
    debugPutStrLn v ("runAuctionCore from " ++ debug_fn) (showAuction auction)
    debugDumpLP v (debug_fn ++ ".lp") lp
    (rc, mb) <- silenceIfNotDebug v $ LP.glpSolveSimplexAll LP.simplexDefaults lp
    case mb of
      Nothing          -> throwIO (GLPKFailed rc)
      Just (_, vs, rs) -> return $ AuctionResult (rowsToGoodPrices rs) (Map.map doubleToUnits vs) (rowsToNormalisedPrice rs)
  where
    v = auction ^. auction_verbosity

-- | Extract the shadow values of the good consistency constraints,
-- which give the prices of the goods.
rowsToGoodPrices :: [LP.RowValue' v Double] -> Map.Map Good Price
rowsToGoodPrices rs = Map.fromList [ (g, round d)
                                   | LP.RowVal' (LP.Constr (Just l) _ _) _ d <- rs
                                   , Just g <- return $ extractGoodFromConstraintLabel l
                                   ]

-- | Extract the shadow value of the TQSS constraint (if there is
-- one), which gives the normalised price.
rowsToNormalisedPrice :: [LP.RowValue' v Double] -> Maybe Price
rowsToNormalisedPrice rs = listToMaybe  [ round d
                                        | LP.RowVal' (LP.Constr (Just l) _ _) _ d <- rs
                                        , l == tqssConstraintLabel
                                        ]

-- | Constraints are labelled by strings in @glpk-hs@, so to find the
-- marginal values of the resource constraints, we have to parse the strings
-- to see if they contain good labels.
extractGoodFromConstraintLabel :: String -> Maybe Good
extractGoodFromConstraintLabel i =
  case words i of
    (i0 : is) | i0 == goodConsistencyConstraintLabel -> readMaybe (unwords is)
    _ -> Nothing

goodConsistencyConstraintLabel :: String
goodConsistencyConstraintLabel = "goodConsistencyConstraint"

tqssConstraintLabel :: String
tqssConstraintLabel = "tqssConstraint"

-- | Whether to introduce explicit constraints into the LP for the
-- step length bounds (instead of just treating them as variables).
-- This shouldn't make a difference to the optimal value, but
-- sometimes it can lead to a different solution being found.
explicitStepLengthConstraints :: Bool
explicitStepLengthConstraints = False


$(makeLenses ''AuctionResult)