State.hs

module Control.Scheduling.State ( State(..)
                                , individualMeetings
                                , groupMeetings
                                , faculty
                                , prospects
                                , slots
                                , granularity
                                , compressSlots
                                , simpleState
                                , requestedMeetings
                                ) where

import Text.Printf ( printf
                   , PrintfArg(..)
                   , fmtPrecision
                   , fmtChar
                   , errorBadFormat
                   , formatString
                   , vFmt
                   , IsChar
                   )
import Control.Lens ((^.), (.~), (&), (<&>), set, view, makeLenses, makeFields, (%~))
import Control.Scheduling.Person (Person(..), availability)
import Control.Scheduling.TimeSpan (TimeSpan(..))
import Control.Scheduling.Preference (Preference(..))
import Data.Text (Text)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.List (intercalate)
import Data.Maybe (fromMaybe, fromJust)
import System.Random
import qualified Control.Monad.State as S

data State = State { _faculty :: [Person]
                   , _prospects :: [Person]
                   , _requestedMeetings :: Maybe [Preference]
                   , _slots :: Maybe [TimeSpan]
                   , _individualMeetings :: Maybe (Map (Text, Text) (Map (Text, Text) [TimeSpan])) -- faculty to student
                   , _groupMeetings :: Maybe (Map (Text, Text) (Map [(Text, Text)] [TimeSpan]))
                   , _granularity :: Maybe Int
                   , _interviewerSheet :: Text
                   , _prospectSheet :: Text
                   , _interviewerAvailabilitySheet :: Text
                   , _prospectAvailabilitySheet :: Text
                   , _individualPreferenceSheet :: Text
                   , _groupPreferenceSheet :: Text
                   , _interviewerScheduleSheet :: Text
                   , _prospectScheduleSheet :: Text
                   } deriving (Show)

instance PrintfArg State where
  formatArg State{..} fmt | fmtChar (vFmt 'P' fmt) == 'P' = formatString (printf "State:\n\n  Interviewers:\n%s\n\n  Prospects:\n%s\n\n  Slots:\n%s\n " facs prosps slots :: String) (fmt { fmtChar = 's', fmtPrecision = Nothing })
    where
      facs = intercalate "\n" (map (printf "    %s") _faculty :: [String])
      prosps = intercalate "\n" (map (printf "    %s") _prospects :: [String])
      slots = printf "    %d" ((length . fromMaybe []) _slots :: Int) :: String

makeLenses ''State

simpleState = State [] [] Nothing Nothing Nothing Nothing Nothing "Interviewers" "Prospects" "Interviewer Availability" "Prospect Availability" "Individual Preferences" "Group Preferences" "Interviewer Schedule" "Prospect Schedule"

filtAvail :: (Ord a) => Set a -> Maybe [a] -> Maybe [a]
filtAvail keep others = Just $ Set.toList toKeep
  where
    others' = (Set.fromList . fromJust) others
    toKeep = Set.intersection others' keep

compressSlots :: State -> State
compressSlots state@(State{..}) = state & faculty .~ faculty' & prospects .~ prospects' & slots .~ slots'
  where
    allFacAvail = Set.fromList $ concat [fromJust $ f ^. availability | f <- _faculty]
    allProspAvail = Set.fromList $ concat [fromJust $ f ^. availability | f <- _prospects]
    allSlots = Set.fromList $ fromJust _slots
    overlap' = Set.intersection allFacAvail allProspAvail
    overlap = Set.intersection overlap' allSlots
    faculty' = [p & availability %~ filtAvail overlap | p <- _faculty]
    prospects' = [p & availability %~ filtAvail overlap | p <- _prospects]
    slots' = Just $ Set.toList overlap
-- randomizeEntries :: State -> IO State
-- randomizeEntries s = do
--   faculty' <- randomizeAvailability (_faculty s) (_slots s)
--   faculty'' <- sequence $ map (randomizePreferences (_prospects s)) faculty'
--   return $ s { _faculty=faculty'' } 

-- randomizePreferences :: [Person] -> Person -> IO Person
-- randomizePreferences prosp fac = do
--   r <- newStdGen
--   let rs = randomRs (0.0, 1.0) r :: [Double]
--       bs = map (\v -> if v < 0.5 then 0 else if v < 0.85 then 1 else 1) rs
--   return $ fac { _preferences=Just $ Map.fromList $ zip prosp bs }
  
-- randomizeAvailability :: [Person] -> Maybe [TimeSpan] -> IO [Person]
-- randomizeAvailability fac slots = do
--   return $ [p { _availability=slots }| p <- fac]