diff options
Diffstat (limited to 'users/Profpatsch/ical-smolify/IcalSmolify.hs')
| -rw-r--r-- | users/Profpatsch/ical-smolify/IcalSmolify.hs | 124 |
1 files changed, 124 insertions, 0 deletions
diff --git a/users/Profpatsch/ical-smolify/IcalSmolify.hs b/users/Profpatsch/ical-smolify/IcalSmolify.hs new file mode 100644 index 000000000000..77264d16937e --- /dev/null +++ b/users/Profpatsch/ical-smolify/IcalSmolify.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -Wall #-} + +module Main where + +import qualified Data.ByteString.Lazy as Bytes.Lazy +import qualified Data.CaseInsensitive as CaseInsensitive +import qualified Data.Default as Default +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import ExecHelpers (dieUserError, CurrentProgramName) +import MyPrelude +import qualified System.Environment as Env +import Text.ICalendar +import Prelude hiding (log) + +main :: IO () +main = do + Env.getArgs >>= \case + [] -> dieUserError progName "First argument must be the ics file name" + (file : _) -> + do + parse file + >>= traverse_ + ( \vcal -> + vcal + & stripSingleTimezone + & minify + & printICalendar Default.def + & Bytes.Lazy.putStr + ) + +progName :: CurrentProgramName +progName = "ical-smolify" + +log :: Error -> IO () +log err = do + putStderrLn (errorContext "ical-smolify" err & prettyError) + +parse :: FilePath -> IO [VCalendar] +parse file = do + parseICalendarFile Default.def file >>= \case + Left err -> do + dieUserError progName [fmt|Cannot parse ical file: {err}|] + Right (cals, warnings) -> do + for_ warnings (\warn -> log [fmt|Warning: {warn}|]) + pure cals + +-- | Converts a single timezone definition to the corresponding X-WR-Timezone field. +stripSingleTimezone :: VCalendar -> VCalendar +stripSingleTimezone vcal = + case vcal & vcTimeZones & Map.toList of + [] -> vcal + [(_, tz)] -> do + let xtz = + OtherProperty + { otherName = CaseInsensitive.mk "X-WR-TIMEZONE", + otherValue = tz & vtzId & tzidValue & textToBytesUtf8Lazy, + otherParams = OtherParams Set.empty + } + vcal + { vcOther = + vcal & vcOther + -- remove any existing x-wr-timezone fields + & Set.filter (\prop -> (prop & otherName) /= (xtz & otherName)) + & Set.insert xtz, + vcTimeZones = Map.empty + } + _more -> vcal + +-- | Minify the vcalendar event by throwing away everything that’s not an event. +minify :: VCalendar -> VCalendar +minify vcal = + vcal + { vcProdId = ProdId "" (OtherParams Set.empty), + -- , vcVersion :: ICalVersion + -- , vcScale :: Scale + -- , vcMethod :: Maybe Method + -- , vcOther :: … + -- , vcTimeZones :: Map Text VTimeZone + vcEvents = Map.map minifyEvent (vcal & vcEvents), + vcTodos = Map.empty, + vcJournals = Map.empty, + vcFreeBusys = Map.empty, + vcOtherComps = Set.empty + } + +minifyEvent :: VEvent -> VEvent +minifyEvent vev = + vev +-- { veDTStamp :: DTStamp +-- , veUID :: UID +-- , veClass :: Class -- ^ 'def' = 'Public' +-- , veDTStart :: Maybe DTStart +-- , veCreated :: Maybe Created +-- , veDescription :: Maybe Description +-- , veGeo :: Maybe Geo +-- , veLastMod :: Maybe LastModified +-- , veLocation :: Maybe Location +-- , veOrganizer :: Maybe Organizer +-- , vePriority :: Priority -- ^ 'def' = 0 +-- , veSeq :: Sequence -- ^ 'def' = 0 +-- , veStatus :: Maybe EventStatus +-- , veSummary :: Maybe Summary +-- , veTransp :: TimeTransparency -- ^ 'def' = 'Opaque' +-- , veUrl :: Maybe URL +-- , veRecurId :: Maybe RecurrenceId +-- , veRRule :: Set RRule +-- , veDTEndDuration :: Maybe (Either DTEnd DurationProp) +-- , veAttach :: Set Attachment +-- , veAttendee :: Set Attendee +-- , veCategories :: Set Categories +-- , veComment :: Set Comment +-- , veContact :: Set Contact +-- , veExDate :: Set ExDate +-- , veRStatus :: Set RequestStatus +-- , veRelated :: Set RelatedTo +-- , veResources :: Set Resources +-- , veRDate :: Set RDate +-- , veAlarms :: Set VAlarm +-- , veOther :: Set OtherProperty +-- } |