Availability.hs

{-# LANGUAGE CPP, MultiParamTypeClasses #-}
{-
	Copyright (C) 2013-2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	WeekDaze is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	Describes the availability of some /resource/.

 [@CAVEAT@]

	* Availability, as defined here, can only be defined for each whole /day/ in any unspecified week,
	rather than individual time-slots within a day, or sporadic days in the year.
	This restriction isn't conceptual, but merely for the tractability of the code.

	* Resources available for only part of a /day/, can't be directly accommodated.
-}

module WeekDaze.Temporal.Availability(
-- * Types
-- ** Data-types
	Availability(
		deconstruct
	),
-- * Constants
	tag,
--	fulltime,
--	unavailable,
-- * Functions
--	availabilityParser,
	calculateAvailabilityRatio,
	countDaysPerWeekAvailable,
	countInternalAvailabilityGaps,
	findIntersection,
	findIntersections,
--	findUnion,
	findUnions,
-- ** Constructor
	mkAvailability,
-- ** Predicates
	isFulltime,
	isUnavailable,
	isAvailableOn
#ifdef USE_HDBC
-- ** Translation
	,fromMySqlSet
	,toMySqlSet
#endif
) where

import			Control.Arrow((&&&))
import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.Set
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT
import qualified	ToolShed.SelfValidate
import qualified	WeekDaze.Size			as Size
import qualified	WeekDaze.Temporal.Day		as Temporal.Day

#ifdef USE_HDBC
import qualified	Database.HDBC
import qualified	Data.Convertible
import qualified	WeekDaze.Database.Selector	as Database.Selector

instance Data.Convertible.Convertible Database.HDBC.SqlValue Availability {-multi-parameter type-class-} where
	safeConvert	= fmap fromMySqlSet . Data.Convertible.safeConvert

-- | Constructs an /Availability/ from a MySql set.
fromMySqlSet :: String -> Availability
fromMySqlSet	= mkAvailability . Database.Selector.fromMySqlSet

-- | Constructs a MySql set from an /Availability/.
toMySqlSet :: Availability -> String
toMySqlSet	= Database.Selector.toMySqlSet . Data.Set.toList . deconstruct
#endif /* USE_HDBC */

-- | Used to qualify SQL & XML.
tag :: String
tag	= "availability"

-- | The set of /day/s on which an arbitrary /resource/ is /available/.
newtype Availability	= MkAvailability {
	deconstruct	:: Data.Set.Set Temporal.Day.Day
} deriving (Eq, Ord)

instance Show Availability where
	showsPrec _	= shows . Data.Set.toList . deconstruct	-- Hides the data-constructor.

instance Control.DeepSeq.NFData Availability where
	rnf	= Control.DeepSeq.rnf . deconstruct

-- | Constant.
fulltime :: Availability
fulltime	= mkAvailability Temporal.Day.range

-- | Constant.
unavailable :: Availability
unavailable	= MkAvailability Data.Set.empty

instance Data.Default.Default Availability where
	def	= fulltime

{- |
	* Smart constructor.

	* Prevents one directly constructing an un/available/ /resource/, though one can indirectly as a result of an operation which returns a new one; e.g. 'findIntersection'.
-}
mkAvailability :: [Temporal.Day.Day] -> Availability
mkAvailability days
	| ToolShed.SelfValidate.isValid availability	= availability
	| otherwise					= error $ "WeekDaze.Temporal.Availability.mkAvailability:\t" ++ ToolShed.SelfValidate.getFirstError availability ++ "."
	where
		availability	= MkAvailability $ Data.Set.fromList days

instance ToolShed.SelfValidate.SelfValidator Availability where
	getErrors availability	= ToolShed.SelfValidate.extractErrors [(isUnavailable availability, "no availability")]

instance HXT.XmlPickler Availability where
	xpickle	= HXT.xpElem tag . HXT.xpWrap (
		mkAvailability,			-- Construct from a List.
		Data.Set.toList . deconstruct	-- Deconstruct to a List.
	 ) $ HXT.xpList1 {-can't be null-} HXT.xpickle

-- | The number of /day/s per week, which can be considered /available/.
countDaysPerWeekAvailable :: Availability -> Size.NDays
countDaysPerWeekAvailable	= Data.Set.size . deconstruct

-- | Counts non-terminal blocks of consecutive un/available/ /day/s.
countInternalAvailabilityGaps :: Availability -> Size.NDays
countInternalAvailabilityGaps available
	| isUnavailable available	= 0
	| otherwise			= length . filter (
		> 1		-- Select non-consecutive available days.
	) . uncurry (
		zipWith (-)	-- Measure the unavailable duration between successive available days.
	) . (
		map fromEnum . tail &&& map fromEnum . init
	) . Data.Set.toAscList $ deconstruct available

-- | Returns the ratio of the available portion of the week, to the whole week (including weekends).
calculateAvailabilityRatio :: Fractional f => Availability -> f
calculateAvailabilityRatio	= (/ fromIntegral Temporal.Day.nDaysPerWeek) . fromIntegral . countDaysPerWeekAvailable

-- | Returns the /day/s on which both /resource/s are /available/.
findIntersection :: Availability -> Availability -> Availability
findIntersection (MkAvailability l) (MkAvailability r)	= MkAvailability $ Data.Set.intersection l r

-- | Returns the /day/s on which all the specified /resource/s are /available/.
findIntersections :: Data.Foldable.Foldable foldable => foldable Availability -> Availability
findIntersections	= Data.Foldable.foldr findIntersection fulltime

-- | Returns the /day/s on which either /resource/ is /available/.
findUnion :: Availability -> Availability -> Availability
findUnion (MkAvailability l) (MkAvailability r)	= MkAvailability $ Data.Set.union l r

-- | Returns the /day/s on which any of the specified /resource/s is /available/.
findUnions :: Data.Foldable.Foldable foldable => foldable Availability -> Availability
findUnions	= Data.Foldable.foldr findUnion unavailable

-- | True if the /resource/ is available every /day/.
isFulltime :: Availability -> Bool
isFulltime	= (== Temporal.Day.nDaysPerWeek) . Data.Set.size . deconstruct

{- |
	* 'True' is the /resource/ is available on zero /day/s.

	* CAVEAT: an 'Availability' which is completely un/available/, can't be constructed by 'mkAvailability', but it can result from 'findIntersection'.
-}
isUnavailable :: Availability -> Bool
isUnavailable	= Data.Set.null . deconstruct

-- | True if the unspecified /resource/ is available on the specified /day/.
isAvailableOn :: Temporal.Day.Day -> Availability -> Bool
isAvailableOn day	= (day `Data.Set.member`) . deconstruct