ICal2.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module ICal2 where

import qualified Data.ByteString.Lazy as DBL
import           Data.CaseInsensitive
import           Data.Default
import           Data.Functor
import qualified Data.Map.Lazy        as DML
import           Data.Maybe
import qualified Data.Set             as DS
import qualified Data.Text.Lazy       as DTL
import           Data.Time.LocalTime
import           Data.Version
import           Data.Time.Format
import           Text.ICalendar.Parser
import           Text.ICalendar.Printer
import qualified Text.ICalendar.Types as I
import           Text.ICalendar.Types
  (
    Date
  , DateTime
  , DTEnd
  , DTStart
  , OtherParams
  , TZProp
  , VCalendar
  , VEvent
  , VTimeZone
  , VTodo
  )

--------------------- Instances ----------------------
instance Default VTimeZone where
  def =
    let tzid         = "Europe/Berlin"
        vtzId        = I.TZID tzid True def
        vtzLastMod   = def
        vtzUrl       = def
        vtzStandardC = myzone "1996-10-27 03:00:00" 3600 7200 "CET"
        vtzDaylightC = myzone "1981-03-29 02:00:00" 7200 3600 "CEST"
        vtzOther     = def
    in  I.VTimeZone{..}
      where
        myzone timestr tzto tzfrom tzname =
          DS.singleton
            $ def {
              I.tzpDTStart = fromJust . timeToDTStart "%F %T" $ timestr
              , I.tzpTZOffsetTo = I.UTCOffset tzto def
              , I.tzpTZOffsetFrom = I.UTCOffset tzfrom def
              , I.tzpTZName = DS.singleton
                              $ I.TZName tzname def def
            }


instance Default TZProp where
  def =
    let tzpDTStart      = fromJust
                            . timeToDTStart "%F %T"
                            $ "2000-01-01 00:00:00"
        tzpTZOffsetTo   = I.UTCOffset 0 def
        tzpTZOffsetFrom = I.UTCOffset 0 def
        tzpRRule        = def
        tzpComment      = def
        tzpRDate        = def
        tzpTZName       = DS.singleton $ I.TZName "CET" def def
        tzpOther        = def
    in  I.TZProp{..}
-----------------------------------------------------


--------------------- helpers ----------------------
formatDateTime :: String -> String -> Maybe DateTime
formatDateTime format timestring =
  let localDate :: Maybe LocalTime
      localDate = parseTimeM False defaultTimeLocale format timestring
  in  fmap I.FloatingDateTime localDate

timeToDTStart :: String -> String -> Maybe DTStart
timeToDTStart format timestring =
  (`I.DTStartDateTime` def) <$> formatDateTime format timestring

timeToDTEnd :: String -> String -> Maybe DTEnd
timeToDTEnd format timestring =
  (`I.DTEndDateTime` def) <$> formatDateTime format timestring
----------------------------------------------------


myCalendar :: VCalendar
myCalendar =
  def {
      I.vcMethod = Just $ I.Method  (mk . DTL.pack $ "PUBLISH") def
    , I.vcTimeZones = DML.singleton "Europe/Berlin" def
  }

----------- IO stuff -----------

readIcalFile :: FilePath -> IO (Maybe VCalendar)
readIcalFile fp =
  do
    et <- parseICalendarFile def fp
    case et of
      Right (x:_, _) -> return (Just x)
      Right ([], _)  -> return Nothing
      Left  _        -> return Nothing

main :: IO ()
main = do
  let calBS = printICalendar def myCalendar
  DBL.putStr calBS

--------------------------------