scheduling-0.1.0.0: src/Control/Scheduling/Sheets.hs

module Control.Scheduling.Sheets (readSpreadsheet, readState, writeForms, writeSchedule, sheetLookup) where

import Prelude hiding (group)
import qualified Network.Google.Sheets as S
import Network.Google.Resource.Sheets.Spreadsheets.Get
import Network.Google.Sheets hiding (Text, sheet)
import Network.Google
import Data.Aeson.Types
import Data.Text (Text, unpack, pack)
import qualified Data.Text as T
import Text.Printf (printf, PrintfArg(..), fmtPrecision, fmtChar, errorBadFormat, formatString, vFmt, IsChar)
import Control.Lens hiding (zoom)
import Control.Exception (try, tryJust)
import Control.Monad (join)
import Data.Maybe (catMaybes, fromJust, fromMaybe)
import Data.Time.Clock (UTCTime(..), secondsToNominalDiffTime)
import Data.Time.Format
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.Random
import Data.Int (Int32)
import Control.Scheduling.State
import Control.Scheduling.Person
import Control.Scheduling.TimeSpan
import Control.Scheduling.Preference
import Data.Time
import Text.Read (readMaybe)
import Data.List (intercalate, sort)
import Debug.Trace (traceShowId)
import qualified Data.Text as Text


readState :: Maybe [TimeSpan] -> Spreadsheet -> State
readState allSlots ssheet = simpleState & faculty .~ faculty' & prospects .~ prospects' & slots .~ allSlots & individualMeetings .~ indiv & requestedMeetings .~ requestedMeetings'
  where
    prospects' = (getPeople "Prospects") ssheet --
    --prospects' = (getAvailability "Prospect Availability" ssheet . getPeople "Prospects") ssheet
    faculty' = (getPeople "Interviewers") ssheet --(getAvailability "Interviewer Availability" ssheet . getPeople "Interviewers") ssheet
    requestedMeetings' = Just $ (getIndividualPrefs "Individual Preferences" ssheet) ++ (getGroupPrefs "Group Preferences" ssheet)
    slu = ssheet^.sheetLookup    
    flu = Map.fromList $ [(T.unwords [T.take 1 (p ^. firstName), p ^. lastName], (p ^. firstName, p ^. lastName)) | p <- prospects']
    indiv = Just $ if "Interviewer Schedule" `Map.member` slu then Map.fromList $ [((f ^. firstName, f ^. lastName), getFacultySchedule "Interviewer Schedule" ssheet f flu) | f <- faculty'] else Map.empty


writeForms :: Text -> Maybe Int32 -> Maybe Int32 -> Maybe Int32 -> State -> IO ()
writeForms sid aid pid ppid state = do
  case pid of
    Nothing -> return ()
    Just tid -> deleteTab sid tid
  case aid of
    Nothing -> return ()
    Just tid -> deleteTab sid tid    
  case ppid of
    Nothing -> return ()
    Just tid -> deleteTab sid tid
  createPreferenceForm sid (state ^. faculty) (state ^. prospects)
  createAvailabilityForm "Interviewer Availability" sid (state ^. faculty) (fromJust $ state ^. slots)
  createAvailabilityForm "Prospect Availability" sid (state ^. prospects) (fromJust $ state ^. slots)
  return ()


tab :: Text -> Lens' Spreadsheet Sheet
tab name = lens (\ss -> fromJust $ ssheet ss name) undefined

addTab sid name nRows nCols index = do
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  let gp = gridProperties & gpColumnCount ?~ nCols & gpRowCount ?~ nRows & gpFrozenRowCount ?~ 1 & gpFrozenColumnCount ?~ 2
      sp = sheetProperties & sTitle ?~ name & sGridProperties ?~ gp & sIndex ?~ (fromIntegral index)
      asr = asrProperties ?~ sp $ addSheetRequest
  rv' <- try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqAddSheet .~ Just asr $ request')] $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  let Right rv = rv'
  return $ fromJust $ (fromJust $ (fromJust $ (head $ rv ^. busrReplies) ^. rAddSheet) ^. aProperties) ^. sSheetId


tabId :: Sheet -> Maybe Int32
tabId s = join $ s ^. sProperties <&> view sSheetId


deleteTab :: Text -> Int32 -> IO ()
deleteTab sid tid = do
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  let req = deleteSheetRequest & dsrSheetId .~ Just tid
  resp <- try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqDeleteSheet .~ Just req $ request')] $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  return ()


preferenceEntryFormat :: Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int -> [ConditionalFormatRule]
preferenceEntryFormat tid sr sc er ec n = [neg]
  where
    cv = [conditionValue & cvUserEnteredValue ?~ (pack . show) i | i <- [0, n]]
    bc = booleanCondition & bcValues .~ cv & bcType ?~ NumberNotBetween
    cf = cellFormat & cfBackgRoundColor ?~ (color & cRed ?~ 0.9 & cAlpha ?~ 0.1)
    br = booleanRule & brFormat ?~ cf & brCondition ?~ bc
    range = gridRange & grSheetId ?~ tid & grStartRowIndex ?~ sr & grEndRowIndex ?~ (fromIntegral $ er + 1) & grStartColumnIndex ?~ sc & grEndColumnIndex ?~ (fromIntegral $ ec + 1)
    neg = conditionalFormatRule & cfrBooleanRule ?~ br & cfrRanges .~ [range]


availabilityEntryFormat :: Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> [ConditionalFormatRule]
availabilityEntryFormat tid sr sc er ec = [neg]
  where
    bc = booleanCondition & bcType ?~ NotBlank
    cf = cellFormat & cfBackgRoundColor ?~ (color & cGreen ?~ 0.9 & cAlpha ?~ 0.1)
    br = booleanRule & brFormat ?~ cf & brCondition ?~ bc
    range = gridRange & grSheetId ?~ tid & grStartRowIndex ?~ sr & grEndRowIndex ?~ (fromIntegral $ er + 1) & grStartColumnIndex ?~ sc & grEndColumnIndex ?~ (fromIntegral $ ec + 1)
    neg = conditionalFormatRule & cfrBooleanRule ?~ br & cfrRanges .~ [range]


headerFormat :: TextFormatRun
headerFormat = textFormatRun & tfrStartIndex .~ Just 0 & tfrFormat .~ Just (textFormat & tfBold .~ Just True)


--prefHelp = extendedValue & evStringValue ?~ "Instructions: indicate how much time you would like with each prospect, from 0-4 15-minute increments.  0 indicates you *will not* meet with the student, while a blank indicates you are *willing* to do so, to help round out the schedule.  The form will highlight invalid entries in red."
prefHelp = extendedValue & evStringValue ?~ "Instructions: enter '1' if you consider the student a potential advisee (one-on-one, hour-long meeting), '0' if you won't meet with the student *at all* (use sparingly, if at all), blank indicates you will meet with the student as part of a group" -- , but don't consider them a match as an advisee."

schedHelp = extendedValue & evStringValue ?~ "Instructions: enter any value to indicate you are available at that time (the particular value doesn't matter)"

--"how much time you would like with each prospect, from 0-4 15-minute increments.  0 indicates you *will not* meet with the student, while a blank indicates you are *willing* to do so, to help round out the schedule.  The form will highlight invalid entries in red."


createPreferenceForm sid facs prosps = do
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  let nRows = fromIntegral $ length prosps + 2
      nCols = fromIntegral $ length facs + 2
  tid <- addTab sid "Interviewer Preferences" nRows nCols 3
  let range = gridRange & grStartRowIndex .~ Just 0 & grEndRowIndex .~ Just nRows & grStartColumnIndex .~ Just 0 & grEndColumnIndex .~ Just nCols & grSheetId .~ Just tid
      header = map (\x -> x & cdTextFormatRuns .~ [headerFormat]) ([cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "First"), cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "Last")] ++ [cellData & cdUserEnteredValue .~ Just (extendedValue & evStringValue .~ Just _lastName) | Person{..} <- facs])
      rows = [rowData & rdValues .~ header] ++ [preferenceRow i (fromIntegral nCols) p | (i, p) <- zip [1..] prosps]
      help = [rowData & rdValues .~ [cellData & cdUserEnteredValue ?~ prefHelp]]
      req = updateCellsRequest & updRange .~ Just range & updFields .~ (Just . GFieldMask) "*"  & updRows .~ rows
      req' = updateCellsRequest & updRange ?~ (gridRange & grStartRowIndex ?~ (nRows - 1) & grEndRowIndex ?~ nRows & grStartColumnIndex ?~ 0 & grEndColumnIndex ?~ 1 & grSheetId ?~ tid) & updRows .~ help & updFields ?~ GFieldMask "*"
      fmts = [addConditionalFormatRuleRequest & acfrrRule ?~ fmt | fmt <- preferenceEntryFormat tid 1 2 (nRows - 1) nCols 4]
      fmtReqs = [reqAddConditionalFormatRule ?~ fmtReq $ request' | fmtReq <- fmts]
      resize = autoResizeDimensionsRequest & ardrDimensions ?~ (dimensionRange & drDimension ?~ DRDColumns & drSheetId ?~ tid & drStartIndex ?~ 0 & drEndIndex ?~ nCols)
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req $ request')] ++ fmtReqs ++ [reqAutoResizeDimensions .~ Just resize $ request']$ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [reqAutoResizeDimensions .~ Just resize $ request']$ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req' $ request')] $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  return ()


preferenceRow :: Int -> Int -> Person -> RowData
preferenceRow row nCols prosp = rowData & rdValues .~ (filled ++ rest)
  where
    f = prosp ^. firstName
    l = prosp ^. lastName
    --b = prosp ^. biography
    u = fromMaybe "www.google.com" (prosp ^. application)
    f' = T.concat ["=HYPERLINK(\"", u, "\", \"", f, "\")"]
    l' = T.concat ["=HYPERLINK(\"", u, "\", \"", l, "\")"]
    fv = extendedValue & evFormulaValue .~ Just f'    
    lv = extendedValue & evFormulaValue .~ Just l'
    filled = [] -- [cellData & cdUserEnteredValue .~ Just fv & cdNote .~ b, cellData & cdUserEnteredValue .~ Just lv & cdNote .~ b]
    rest = replicate (nCols - (length filled)) (cellData & cdNote ?~ "")


availabilityRow :: Int -> Int -> TimeSpan -> RowData
availabilityRow row nCols slot = rowData & rdValues .~ (filled ++ rest)
  where
    f = slot ^. start
    l = slot ^. end
    f' = (pack . formatTime defaultTimeLocale "%a %R") f
    l' = (pack . formatTime defaultTimeLocale "%a %R") l
    fv = extendedValue & evStringValue .~ Just f'    
    lv = extendedValue & evStringValue .~ Just l'
    filled = [cellData & cdUserEnteredValue .~ Just fv, cellData & cdUserEnteredValue .~ Just lv]
    rest = replicate (nCols - (length filled)) cellData


writeGrid sid tid xs = do
  undefined


createAvailabilityForm name sid facs slots = do
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  let nRows = fromIntegral $ length slots + 2
      nCols = fromIntegral $ length facs + 2
  tid <- addTab sid name nRows nCols 3
  let range = gridRange & grStartRowIndex .~ Just 0 & grEndRowIndex .~ Just nRows & grStartColumnIndex .~ Just 0 & grEndColumnIndex .~ Just nCols & grSheetId .~ Just tid
      header = map (\x -> x & cdTextFormatRuns .~ [headerFormat]) ([cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "Start"), cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "End")] ++ [cellData & cdUserEnteredValue .~ Just (extendedValue & evStringValue .~ Just _lastName) | Person{..} <- facs])      
      rows = [rowData & rdValues .~ header] ++ [availabilityRow i (fromIntegral nCols) p | (i, p) <- zip [1..] slots]
      help = [rowData & rdValues .~ [cellData & cdUserEnteredValue ?~ schedHelp]]
      req = updateCellsRequest & updRange .~ Just range & updFields .~ (Just . GFieldMask) "*"  & updRows .~ rows
      req' = updateCellsRequest & updRange ?~ (gridRange & grStartRowIndex ?~ (nRows - 1) & grEndRowIndex ?~ nRows & grStartColumnIndex ?~ 0 & grEndColumnIndex ?~ 1 & grSheetId ?~ tid) & updRows .~ help & updFields ?~ GFieldMask "*"
      fmts = [addConditionalFormatRuleRequest & acfrrRule ?~ fmt | fmt <- availabilityEntryFormat tid 1 2 nRows nCols]
      fmtReqs = [reqAddConditionalFormatRule ?~ fmtReq $ request' | fmtReq <- fmts]
      resize = autoResizeDimensionsRequest & ardrDimensions ?~ (dimensionRange & drDimension ?~ DRDColumns & drSheetId ?~ tid & drStartIndex ?~ 0 & drEndIndex ?~ nCols)
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req $ request')] ++ fmtReqs ++ [reqAutoResizeDimensions .~ Just resize $ request']$ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req' $ request')] $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  return ()


writeSchedule :: Text -> Maybe Int32 -> Maybe Int32 -> State -> [TimeSpan] -> IO ()
writeSchedule sid tidF tidP state ts = do

  let ims = fromMaybe Map.empty (state ^. individualMeetings)
      --gms = fromMaybe Map.empty (state ^. groupMeetings)
  case tidF of
    Nothing -> return ()
    Just tid -> deleteTab sid tid
  let nRows = fromIntegral $ 1 + (length $ state ^. faculty)
      nCols = fromIntegral $ 2 + (length ts)
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  tidF' <- addTab sid "Interviewer Schedule" nRows nCols 3
  let range = gridRange & grStartRowIndex .~ Just 0 & grEndRowIndex .~ Just nRows & grStartColumnIndex .~ Just 0 & grEndColumnIndex .~ Just nCols & grSheetId .~ Just tidF'
      header = map (\x -> x & cdTextFormatRuns .~ [headerFormat]) ([cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "First"), cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "Last")] ++ [cellData & cdUserEnteredValue .~ Just (extendedValue & evStringValue .~ Just (pack . formatTime defaultTimeLocale "%a %R" $ t ^. start)) | t <- ts])
      rows = [rowData & rdValues .~ header] ++ [scheduleFacultyRow ts n v | (n, v) <- (Map.toList . fromJust) (state ^. individualMeetings)]
      fmtReqs = []
      req = updateCellsRequest & updRange .~ Just range & updFields .~ (Just . GFieldMask) "*"  & updRows .~ rows
  try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req $ request')] ++ fmtReqs $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)

  case tidP of
    Nothing -> return ()
    Just tid -> deleteTab sid tid    

  let nRows = fromIntegral $ 1 + (length $ state ^. prospects)
      nCols = fromIntegral $ 2 + (length ts)
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  tidP' <- addTab sid "Prospect Schedule" nRows nCols 2
  let range = gridRange & grStartRowIndex .~ Just 0 & grEndRowIndex .~ Just nRows & grStartColumnIndex .~ Just 0 & grEndColumnIndex .~ Just nCols & grSheetId .~ Just tidP'
      header = map (\x -> x & cdTextFormatRuns .~ [headerFormat]) ([cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "First"), cellData & cdUserEnteredValue ?~ (extendedValue & evStringValue ?~ "Last")] ++ [cellData & cdUserEnteredValue .~ Just (extendedValue & evStringValue .~ Just (pack . formatTime defaultTimeLocale "%a %R" $ t ^. start)) | t <- ts])
      rows = [rowData & rdValues .~ header] ++ [scheduleProspectRow ts (p ^. fullName) (fromMaybe Map.empty $ state ^. individualMeetings)| p <- (state ^. prospects)]
      fmtReqs = []
      req = updateCellsRequest & updRange .~ Just range & updFields .~ (Just . GFieldMask) "*"  & updRows .~ rows
  x <- try . runResourceT . runGoogle env $ send (spreadsheetsBatchUpdate sid (busrRequests .~ [(reqUpdateCells .~ Just req $ request')] ++ fmtReqs $ batchUpdateSpreadsheetRequest)) :: IO (Either Error BatchUpdateSpreadsheetResponse)
  --print x
  return ()


scheduleFacultyRow :: [TimeSpan] -> (Text, Text) -> Map (Text, Text) [TimeSpan] -> RowData
scheduleFacultyRow ts (first, last) vs = rowData & rdValues .~ ([first', last'] ++ rest')
  where
    fv = extendedValue & evStringValue .~ Just first
    lv = extendedValue & evStringValue .~ Just last
    first' = cellData & cdUserEnteredValue .~ Just fv
    last' = cellData & cdUserEnteredValue .~ Just lv
    restMap = Map.fromList $ concat [[(x, pack $ [head $ unpack f] ++ " " ++ (unpack l)) | x <- xs] | ((f, l), xs) <- Map.toList vs]
    --gRestMap = Map.fromList $ concat [[(x, T.intercalate "/" (map (id . snd) ns)) | x <- xs] | (ns, xs) <- Map.toList gvs]
    --rest = [extendedValue & evStringValue ?~ (Map.findWithDefault (if elem t knownEvents then "EVENT" else (Map.findWithDefault "" t gRestMap)) t restMap) | t <- ts]
    rest = [extendedValue & evStringValue ?~ (Map.findWithDefault "" t restMap) | t <- ts]
    rest' = [cellData & cdUserEnteredValue ?~ v | v <- rest]


scheduleProspectRow :: [TimeSpan] -> (Text, Text) -> Map (Text, Text) (Map (Text, Text) [TimeSpan]) -> RowData
scheduleProspectRow ts (first, last) vs = rowData & rdValues .~ ([first', last'] ++ rest')
  where
    fv = extendedValue & evStringValue .~ Just first
    lv = extendedValue & evStringValue .~ Just last
    first' = cellData & cdUserEnteredValue .~ Just fv
    last' = cellData & cdUserEnteredValue .~ Just lv

    rel = concat [[(ss, Text.intercalate " " [Text.take 1 $ fst f, snd f]) | (p, ss) <- Map.toList ps, p == (first, last)] | (f, ps) <- Map.toList vs]
    --rel' = (Map.fromList . map (\(a, b) -> (b, a)) . Map.toList) $
    rel' = Map.fromListWith (\a b -> Text.intercalate ", " [a, b]) rel
    restMap = Map.fromList $ concat [[(t, s) | t <- ts] | (ts, s) <- Map.toList rel']
    --vs''' = Map.fromListWith (\a b -> a) [(v, k) | (k, v) <- Map.toList $ Map.mapKeys (\(a, b) -> Text.intercalate " " [a,b]) vs]
    --restMap = Map.fromList $ concat [ concat [[(t, fs) | t <- vs''] | ((pf, pl), vs'') <- Map.toList vs', (pf, pl) == (first, last)] | (fs, vs') <- Map.toList vs''']
    --restMap = Map.fromList $ concat [ concat [[(t, pack $ [head $ unpack ff] ++ " " ++ (unpack fl)) | t <- vs''] | ((pf, pl), vs'') <- Map.toList vs', (pf, pl) == (first, last)] | ((ff, fl), vs') <- Map.toList vs]
    --gRestMap = Map.fromList $ concat [ concat [[(t, pack $ [head $ unpack ff] ++ " " ++ (unpack fl)) | t <- vs''] | (pns, vs'') <- Map.toList vs', (first, last) `elem` pns] | ((ff, fl), vs') <- Map.toList gvs]
    --gRestMap = Map.fromList []
  --   restMap = Map.fromList $ concat [[(x, pack $ [head $ unpack f] ++ " " ++ (unpack l)) | x <- xs] | ((f, l), xs) <- Map.toList vs]
    rest = [extendedValue & evStringValue ?~ (Map.findWithDefault "" t restMap) | t <- ts]
    rest' = [cellData & cdUserEnteredValue ?~ v | v <- rest]


  
-- createSchedule sid facs prosps slots = do
--   env <- newEnv <&> (envScopes .~ spreadsheetsScope)  
--   addTab sid "Schedule" (fromIntegral $ length prosps + 1) (fromIntegral $ length facs + 2)
--   let cols = ['A'..'Z']
--       facRange = pack $ printf "'Schedule'!A1:%v1" (cols !! (length facs + 2))
--       slotRange = pack $ printf "'Schedule'!A2:B%d" (length slots + 1)
--       facVals = ( vrMajorDimension .~ Just VRMDRows $ vrValues .~ [[String "Start", String "End"] ++ [String _lastName | Person{..} <- facs]] $ vrRange .~ Just facRange $ valueRange)
--       slotVals = ( vrMajorDimension .~ Just VRMDRows $ vrValues .~ [[String $ (pack . formatTime defaultTimeLocale "%a %R") (_start s), String $ (pack . formatTime defaultTimeLocale "%a %R") (_end s)] | s <- slots] $ vrRange .~ Just slotRange $ valueRange)      
--   runResourceT . runGoogle env $ send (svuValueInputOption .~ Just "USER_ENTERED" $ spreadsheetsValuesUpdate sid facVals facRange)
--   runResourceT . runGoogle env $ send (svuValueInputOption .~ Just "USER_ENTERED" $ spreadsheetsValuesUpdate sid slotVals slotRange)  


readSpreadsheet sid = do
  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
  runResourceT . runGoogle env $ send (sgIncludeGridData .~ Just True $ spreadsheetsGet sid)


--readValues sid spec = do
--  env <- newEnv <&> (envScopes .~ spreadsheetsScope)
--  runResourceT . runGoogle env $ send (spreadsheetsValuesGet sid spec)


-- writeValues sid sheet startRow startColumn endRow endColumn values = do
--   env <- newEnv <&> (envScopes .~ spreadsheetsScope)
--   let cols = ['A'..'Z']  
--   return ()




sheetName :: Sheet -> Maybe Text
sheetName s = join $ s ^. sProperties <&> view sTitle


sheetId :: Sheet -> Maybe Int32
sheetId s = join $ s ^. sProperties <&> view sSheetId

  

rowToPerson :: [Text] -> RowData -> Maybe Person
rowToPerson cols rd = do
  let cells = rd ^. rdValues  
      cells' = map (\x -> (x ^. cdFormattedValue, x^.cdHyperlink)) cells
      feats = Map.fromList $ zip cols cells'
      first = (fromJust . fst) $ feats Map.! "First"
      last = (fromJust .fst) $ feats Map.! "Last"
      minMtg = 1 -- (read . unpack) $ fromMaybe "3" (fst $ feats Map.! "Minimum meetings") :: Int
      maxMtg = 2 -- (read . unpack) $ fromMaybe "3" (fst $ feats Map.! "Maximum meetings") :: Int
      maxSz = 2 -- (read . unpack) $ fromMaybe "2" (fst $ feats Map.! "Maximum size") :: Int
      reqOnly = True -- (fromMaybe "FALSE" (fst $ feats Map.! "Requested only")) == "TRUE"
      e = (fst . fromMaybe (Nothing, undefined)) $ "Email" `Map.lookup` feats
      z = (fst . fromMaybe (Nothing, undefined)) $ "Zoom" `Map.lookup` feats
      g = Just "3" -- (fst . fromJust) $ "Group" `Map.lookup` feats
      a = Just "4" -- (snd . fromMaybe (Nothing, Just "")) $ "App" `Map.lookup` feats
  return $ simplePerson first last & email .~ e & zoom .~ z & minMeetings .~ minMtg & maxMeetings .~ maxMtg & requestedOnly .~ reqOnly & maxMeetingSize .~ maxSz & group .~ g & application .~ a


rowToSlot :: RowData -> Maybe TimeSpan
rowToSlot rd = do
  let time:_ = rd ^. rdValues
  time' <- time ^. cdFormattedValue
  let startTime = parseTimeOrError True defaultTimeLocale "" (unpack time')      
  return $ TimeSpan startTime startTime





ssheet :: Spreadsheet -> Text -> Maybe Sheet
ssheet ssheet name = case ss of
                      [] -> Nothing
                      s:_ -> Just s
  where
    ss = [s | s <- ssheet ^. sprSheets, sheetName s == Just name]


sheetLookup :: Lens' Spreadsheet (Map Text Int32)
sheetLookup = lens getter (\x y -> undefined)
  where
    getter ss = Map.fromList $ map (\s -> ((fromJust . sheetName) s, (fromJust . sheetId) s)) (ss ^. sprSheets)


rowToGroupPreference row = simplePreference & intervieweeParticipants .~ (Set.fromList [prosp]) & interviewerParticipants .~ (Set.fromList ints) & priority .~ 2
  where
    first:last:interviewers = rowToStrings row
    prosp = (first, last)
    ints = map ((\(a, b) -> (a, Text.strip b)) . Text.breakOn " ") (filter (\x -> x /= "") interviewers)
    

getGroupPrefs :: Text -> Spreadsheet -> [Preference]
getGroupPrefs sn ss = map rowToGroupPreference rows
  where
    (sheet:_) = [s | s <- ss ^. sprSheets, sheetName s == Just sn]
    (ds:_) = sheet ^. sData
    rows = ds ^. gdRowData . _tail


rowToIndividualPreferences cols row = catMaybes $ map (cellToIndividualPreference (first, last)) (zip cols entries)
  where
    _:_:first:last:entries = rowToStrings row

    
cellToIndividualPreference interviewee (interviewer, value) = case value of "" -> Nothing
                                                                            "x" -> Just $ simplePreference & intervieweeParticipants .~ (Set.fromList [interviewee]) & interviewerParticipants .~ (Set.fromList [interviewer]) & priority .~ 1 & required .~ True
                                                                            _ -> Just $ simplePreference & intervieweeParticipants .~ (Set.fromList [interviewee]) & interviewerParticipants .~ (Set.fromList [interviewer]) & priority .~ 0 & required .~ False


getIndividualPrefs :: Text -> Spreadsheet -> [Preference]
getIndividualPrefs sn ss = concat (map (rowToIndividualPreferences cols) rows)
  where
    (sheet:_) = [s | s <- ss ^. sprSheets, sheetName s == Just sn]
    (ds:_) = sheet ^. sData
    firsts = (drop 4 . rowToStrings . head) $ ds ^. gdRowData
    lasts = (drop 4 . rowToStrings . head . drop 1) $ ds ^. gdRowData
    cols = zip firsts lasts
    rows = (drop 2) $ ds ^. gdRowData


getPeople :: Text -> Spreadsheet -> [Person]
getPeople sn ss = catMaybes $ map (rowToPerson cols) rows
  where
    (sheet:_) = [s | s <- ss ^. sprSheets, sheetName s == Just sn]
    (ds:_) = sheet ^. sData
    cols = rowToStrings $ head $ ds ^. gdRowData
    rows = ds ^. gdRowData . _tail


rowToStrings :: RowData -> [Text]
rowToStrings r = map (\x -> fromMaybe "" (x ^. cdFormattedValue)) (r ^. rdValues)


mon = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-03-08" :: Day
tue = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-03-09" :: Day
wed = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-03-10" :: Day
thu = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-03-11" :: Day
fri = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-03-12" :: Day
--sat = parseTimeOrError True defaultTimeLocale "%Y-%-m-%-d" "2021-02-06" :: Day


stringsToSlot :: Text -> Text -> TimeSpan
stringsToSlot s e = TimeSpan start end
  where
    sd:st:[] = map T.unpack (T.splitOn " " s)
    ed:et:[] = map T.unpack (T.splitOn " " e)
    d = case sd of "Mon" -> mon
                   "Tue" -> tue
                   "Wed" -> wed
                   "Thu" -> thu
                   "Fri" -> fri
                   --"Sat" -> sat
    start = UTCTime d (timeOfDayToTime (parseTimeOrError True defaultTimeLocale "%R" st :: TimeOfDay))
    end = UTCTime d (timeOfDayToTime (parseTimeOrError True defaultTimeLocale "%R" et :: TimeOfDay))


getFacultySchedule :: Text -> Spreadsheet -> Person -> Map Text (Text, Text) -> Map (Text, Text) [TimeSpan]
getFacultySchedule tabName ss fac plu = Map.map fixTimes scheds
  where
    rows = [r | r <- map rowToStrings $ (head  $ ss ^. tab tabName . sData) ^. gdRowData]
    (_:_:slots) = head rows
    row = drop 2 $ head [r | r@(f:l:_) <- rows, (f, l) == (fac^.firstName, fac^.lastName)]
    scheds = Map.fromListWith (++) [(plu Map.! n, [ts]) | (n, ts) <- zip row slots, n /= ""]


fixTimes times = times'
  where
    times' = sort $ map fixTime times
    --s = minimum times'
    --e = maximum times'

fixTime time = TimeSpan s e
  where
    sd = Text.take 3 time
    d = case sd of "Mon" -> mon
                   "Tue" -> tue
                   "Wed" -> wed
                   "Thu" -> thu
                   "Fri" -> fri
                   --"Sat" -> sat
    t = timeOfDayToTime (parseTimeOrError True defaultTimeLocale "%R" (Text.unpack $ Text.drop 4 time) :: TimeOfDay)
    s = UTCTime d t
    e = addUTCTime (secondsToNominalDiffTime (60*60)) s

-- getAvailability :: Text -> Spreadsheet -> [Person] -> [Person]
-- getAvailability tabName ss fac = fac'
--   where
--     (_:_:names):xs = map rowToStrings $ (head  $ ss ^. tab tabName . sData) ^. gdRowData
--     avails = concat $ map (\(s:e:xs') -> [(stringsToSlot s e, n, v) | (n, v) <- zip names xs', v /= ""]) (init xs)
--     fac' = map (\f -> f & availability ?~ [t | (t, n, v) <- avails, f ^. lastName == n]) fac


getAvailability :: Text -> Spreadsheet -> [Person] -> [Person]
getAvailability tabName ss fac = fac --fac'
  where
    (_:_:firsts):(_:_:lasts):xs = map rowToStrings $ (head  $ ss ^. tab tabName . sData) ^. gdRowData
    names = zip firsts lasts
    
    avails = concat $ map (\(s:e:xs') -> [(stringsToSlot s e, n, v) | (n, v) <- zip names xs', v /= ""]) (init xs)
    fac' = map (\f -> f & availability ?~ [t | (t, (first, last), v) <- avails, first==f ^. firstName && last==f ^. lastName]) fac


defaultSlots gran = do
  let dates = ["2021-03-" ++ (show d) | d <- [8,9,10,11,12]]
  slots <- sequence $ [stringsToSlots d d "08:00" "19:00" gran | d <- dates]
  return $ concat slots



getPreferences :: Spreadsheet -> [Person] -> [Person] -> [Person]
getPreferences ss prosps fac = fac'
  where
    (_:_:_:names):xs = map rowToStrings $ (head  $ ss ^. tab "Individual Preferences" . sData) ^. gdRowData
    prefs = concat $ map (\(_:_:l:xs'') -> [(l, n, 1 :: Int) | (n, v) <- zip names xs'', v == "x"]) (init xs)
    plu = Map.fromList [(p ^. lastName, p) | p <- prosps]
    --fac' = map (\f -> f & preferences ?~ Map.fromList [((pf, pl), v) | (pf, pl, n, v) <- prefs, f ^. lastName == n]) fac
    fac' = map (\f -> f & preferences ?~ Map.fromList [(plu Map.! pl, v) | (pl, n, v) <- prefs, f ^. lastName == n]) fac