diff options
Diffstat (limited to 'users/Profpatsch/ical-smolify')
-rw-r--r-- | users/Profpatsch/ical-smolify/IcalSmolify.hs | 124 | ||||
-rw-r--r-- | users/Profpatsch/ical-smolify/README.md | 5 | ||||
-rw-r--r-- | users/Profpatsch/ical-smolify/default.nix | 16 | ||||
-rw-r--r-- | users/Profpatsch/ical-smolify/ical-smolify.cabal | 18 |
4 files changed, 163 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 +-- } diff --git a/users/Profpatsch/ical-smolify/README.md b/users/Profpatsch/ical-smolify/README.md new file mode 100644 index 000000000000..86c166d3c179 --- /dev/null +++ b/users/Profpatsch/ical-smolify/README.md @@ -0,0 +1,5 @@ +# ical-smolify + +Ensmallen an `ical` by stripping out redundant information like timezone definitions. + +The idea here was that after running through this preprocessor, it fits into a QR code (~2000bits) that can be scanned with your phone (for automatically adding to mobile calendar). 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..d7a46c581df2 --- /dev/null +++ b/users/Profpatsch/ical-smolify/ical-smolify.cabal @@ -0,0 +1,18 @@ +cabal-version: 3.0 +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 && <5, + my-prelude, + exec-helpers + data-default + case-insensitive + iCalendar + + default-language: Haskell2010 |