{-# LANGUAGE DeriveFunctor #-}
module Data.LinearProgram.Types (VarKind(..), Direction(..), Bounds(..)) where

import Control.DeepSeq

import Data.Monoid

data VarKind = ContVar | IntVar | BinVar deriving (Eq, Ord, Enum, Show, Read)

-- instance NFData VarKind

instance Monoid VarKind where
	mempty = ContVar
	mappend = max

data Direction = Min | Max deriving (Eq, Ord, Enum, Show, Read)

-- instance NFData Direction

data Bounds a =
	Free | LBound !a | UBound !a | Equ !a | Bound !a !a deriving (Eq, Show, Read, Functor)

-- instance NFData (Bounds a)

-- Bounds form a monoid under intersection.
instance Ord a => Monoid (Bounds a) where
	mempty = Free
	Free `mappend` bd = bd
	bd `mappend` Free = bd
	Equ a `mappend` Equ b
		| a == b	= Equ a
	Equ a `mappend` UBound b
		| a <= b	= Equ a
	Equ a `mappend` LBound b
		| a >= b	= Equ a
	Equ a `mappend` Bound l u
		| a >= l && a <= u
				= Equ a
	Equ _ `mappend` _ = infeasible
	UBound b `mappend` Equ a
		| a <= b	= Equ a
	LBound b `mappend` Equ a
		| a >= b	= Equ a
	Bound l u `mappend` Equ a
		| a >= l && a <= u
				= Equ a
	_ `mappend` Equ _ = infeasible
	LBound a `mappend` LBound b = LBound (max a b)
	LBound l `mappend` UBound u = bound l u
	UBound u `mappend` LBound l = bound l u
	LBound a `mappend` Bound l u = bound (max a l) u
	Bound l u `mappend` LBound a = bound (max a l) u
	UBound a `mappend` UBound b = UBound (min a b)
	UBound a `mappend` Bound l u = bound l (min a u)
	Bound l u `mappend` UBound a = bound l (min a u)
	Bound l u `mappend` Bound l' u' = bound (max l l') (min u u')

infeasible :: Bounds a
infeasible = error "Mutually contradictory constraints found."

bound :: Ord a => a -> a -> Bounds a
bound l u	| l <= u	= Bound l u
		| otherwise	= infeasible