feat(users/Profpatsch): init ical-smolify

ical, but smol

to fit in qr

Change-Id: I37f99a20cfc96b85778a097b7c4f70923f026cd4
Reviewed-on: https://cl.tvl.fyi/c/depot/+/6617
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2022-09-16 22:57:02 +02:00
parent 0532cb6172
commit db093ad10c
3 changed files with 158 additions and 0 deletions

View file

@ -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 thats 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
-- }

View file

@ -0,0 +1,16 @@
{ depot, pkgs, lib, ... }:
let
cas-serve = pkgs.writers.writeHaskell "ical-smolify"
{
libraries = [
pkgs.haskellPackages.iCalendar
depot.users.Profpatsch.my-prelude
depot.users.Profpatsch.execline.exec-helpers-hs
];
ghcArgs = [ "-threaded" ];
} ./IcalSmolify.hs;
in
cas-serve

View file

@ -0,0 +1,18 @@
cabal-version: 2.4
name: ical-smolify
version: 0.1.0.0
author: Profpatsch
maintainer: mail@profpatsch.de
executable ical-smolify
main-is: IcalSmolify.hs
build-depends:
base ^>=4.15.1.0,
my-prelude,
exec-helpers
data-default
case-insensitive
iCalendar
default-language: Haskell2010