IcsToRTM.hs

-- | Takes a .ics file (generated by iCal), finds all the incomplete TODO items,
-- and changes them into a format that can be imported into rememberthemilk.com (RTM).
-- via email
-- <http://www.rememberthemilk.com/help/answers/sending/emailinbox.rtm>.

-- Lee Pike <lee-pike-@gmail-.-com-> (remove dashes)
-- BSD3 License
--
-- NO WARRANTY : This program is incomplete and likely buggy.  Your mileage my vary.
-- 
-- Usage:
-- > runhaskell IcsToRTM.hs Foo.ics 
-- (You must have Haskell <http://hackage.haskell.org/platform/> installed.)
-- Outputs Foo-output.ics, containing space-separated RTM-formatted tasks to mail to RTM.
-- NOTE: Only incomplete tasks are outputted.

module IcsToRTM where

import System.FilePath
import System.Environment
import System.IO
import Data.List

main :: IO ()
main = do
  args <- getArgs
  mapM_ parseICS args

parseICS :: String -> IO ()
parseICS file = do
  str <- readFile file
  let contents = lines str
  let list = getList contents
  -- If we reach the end of the VTODO before seeing a COMPLETED tag, then return
  -- the VTODO.
  let completeBeforeEnd _ [] = []
      completeBeforeEnd tmp (x:xs) | "END:VTODO" `isPrefixOf` x = 
                                       reverse (x:tmp)
                                   | "COMPLETED:" `isPrefixOf` x = []
                                   | otherwise = completeBeforeEnd (x:tmp) xs
  -- Find all the VTODOs that haven't been marked as completed.
  let unfinishedTodos [] = []
      unfinishedTodos (x:xs) 
        | isPrefixOf "BEGIN:VTODO" x =
            completeBeforeEnd [] ("\n":"\n":("List:" ++ list):x:xs)
              ++ unfinishedTodos 
                   (tail $ dropWhile (\y -> not $ "END:VTODO" `isPrefixOf` y) xs)
        | otherwise = 
            unfinishedTodos 
              (dropWhile (\y -> not $ "BEGIN:VTODO" `isPrefixOf` y) xs)
  -- Do the processing.
  let newFile = removeTags $ dueDate $ notes $ task (unfinishedTodos contents)
  -- Make the line terminators consistent by droping carriage returns.
  let strip [] = []
      strip ('\CR':xs) = strip xs
      strip (x:xs) = x : strip xs
  -- Output replaced file.
  let output = (replaceBaseName file) (takeBaseName file ++ "-output")
  writeFile output (strip $ unlines newFile)

notes, removeTags, task, dueDate :: [String] -> [String]

getList :: [String] -> String
getList file = head $
  foldl' (\acc str -> case stripPrefix "X-WR-CALNAME:" str of
                        Nothing -> acc
                        Just str' -> str':acc
         ) [] file

-- | Make the task descriptor.
task file = 
  map (\str -> case stripPrefix "SUMMARY" str of
                 Nothing   -> str
                 Just str' -> "Task" ++ str')
      file

-- | Get the notes.
notes file = snd $ 
  foldl' (\(bool, acc) str -> 
           if bool then case stripPrefix " " str of
                          Nothing -> (False
                                     , (newlines $ head acc) : str : tail acc)
                          Just str' -> (True, (head acc ++ str') : tail acc)
             else case stripPrefix "DESCRIPTION:" str of
                    Nothing   -> (False, str:acc)
                    Just str' -> (True, ("---\n" ++ str'):acc)
        ) (False, []) file
  where newlines ('\\':'n':rst) = '\n' : newlines rst
        newlines (x:rst) = x : newlines rst
        newlines [] = []

-- XXX: Just gets the date right now, not the time.  Not sure if this is an OK
-- format for rememberthemilk.
-- | Make the due date.
dueDate file =
  map (\str -> case stripPrefix "DUE;VALUE=DATE:" str of
                 Nothing   -> str
                 -- Month, Day, Year format.
                 Just date -> 
                   "Due: " ++ months!!((read (take 2 $ drop 4 date)) - 1) 
                           ++ " " ++ (take 2 $ drop 6 date) 
                      ++ ", " ++ take 4 date)
      file

-- Remove all non-rememberthemilk tags.
removeTags file =
  foldl' (\acc str -> if or (map (\x -> isPrefixOf x str) keep) 
                        then str : acc
                        else acc
         ) [] file
  where keep = [ "Priority", "Due", "Repeat", "Estimate", "Tags"
               , "Location", "URL", "List", "Task", "---", "\n"]
  

months :: [String]
months = 
  [ "Jan", "Feb", "Mar", "Apr", "May", "June", "July"
  , "Aug", "Sept", "Oct", "Nov", "Dec"]