From db093ad10c0228b017486cc59b7edd691b1b1b73 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Fri, 16 Sep 2022 22:57:02 +0200 Subject: 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 Tested-by: BuildkiteCI Reviewed-by: Profpatsch --- users/Profpatsch/ical-smolify/IcalSmolify.hs | 124 +++++++++++++++++++++++ users/Profpatsch/ical-smolify/default.nix | 16 +++ users/Profpatsch/ical-smolify/ical-smolify.cabal | 18 ++++ 3 files changed, 158 insertions(+) create mode 100644 users/Profpatsch/ical-smolify/IcalSmolify.hs create mode 100644 users/Profpatsch/ical-smolify/default.nix create mode 100644 users/Profpatsch/ical-smolify/ical-smolify.cabal (limited to 'users/Profpatsch/ical-smolify') 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 +-- } diff --git a/users/Profpatsch/ical-smolify/default.nix b/users/Profpatsch/ical-smolify/default.nix new file mode 100644 index 000000000000..f67d175ce3f3 --- /dev/null +++ b/users/Profpatsch/ical-smolify/default.nix @@ -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 diff --git a/users/Profpatsch/ical-smolify/ical-smolify.cabal b/users/Profpatsch/ical-smolify/ical-smolify.cabal new file mode 100644 index 000000000000..6a1bb6ea8795 --- /dev/null +++ b/users/Profpatsch/ical-smolify/ical-smolify.cabal @@ -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 -- cgit 1.4.1