1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
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
-- }
|
