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:
parent
0532cb6172
commit
db093ad10c
3 changed files with 158 additions and 0 deletions
124
users/Profpatsch/ical-smolify/IcalSmolify.hs
Normal file
124
users/Profpatsch/ical-smolify/IcalSmolify.hs
Normal 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 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
|
||||
-- }
|
16
users/Profpatsch/ical-smolify/default.nix
Normal file
16
users/Profpatsch/ical-smolify/default.nix
Normal 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
|
18
users/Profpatsch/ical-smolify/ical-smolify.cabal
Normal file
18
users/Profpatsch/ical-smolify/ical-smolify.cabal
Normal 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
|
Loading…
Reference in a new issue