module Parser (schedule) where

-- MITSFS iPhone schedule pretty-printer
-- Copyright (C) 2008 Brian Sniffen

-- This program 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 2 of the License, or
-- (at your option) any later version.

-- This program 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 this program; if not, write to the Free Software Foundation, Inc.,
-- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

import Text.ParserCombinators.ReadP

import Model

slot :: ReadP Slot
slot = do
  separator
  sixChars <- count 6 get
  return $ case filter (/=' ') sixChars of
             "" -> Nothing
             keyholder -> Just keyholder

separator :: ReadP ()
separator = string "  " >> return ()

line :: ReadP Line
line = dateLine <++ timeLine <++ junk

junk = return mkJunk

dateLine = do
  dates <- count 7 (skipSpaces >> date)
  return $ head dates
    where 
      date = do
        month <- integer
        char '/'
        day <- integer
        return $ mkDates month day

timeLine = do
  header <- time
  hours <- count 7 slot
  return $ mkTime header hours

time :: ReadP Int
time = do
  skipSpaces
  start <- timeSpec
  string " - "
  end <- timeSpec
  return start

timeSpec :: ReadP Int
timeSpec = noon +++ midnight +++ withAMPM +++ integer
  where
    noon = string "Noon" >> return 12
    midnight = string "Mid" >> return 0
    withAMPM = do
      n <- integer
      string " AM" <++ string " PM"
      return n

integer :: ReadP Int
integer = do
  chars <- munch1 (\c -> c `elem` "0123456789")
  return $ read chars

parseLine = fst . head . readP_to_S line . extendWithSpace
  where
    extendWithSpace x = take 80 $ x ++ repeat ' '


schedule r =
  tail . reverse . snd . foldl collect ([],[]) . map parseLine $ lines r
    where
      collect (accum,result) j | isJunk j = (accum,result)
      collect (accum,result) d | isDate d = ([d], (reverse accum):result)
      collect (accum,result) t | isTime t = (t:accum, result)