Skip to content

Commit d8a8a78

Browse files
0rphee0rphee
committed
ical support working
1 parent 068a87b commit d8a8a78

8 files changed

Lines changed: 86 additions & 71 deletions

File tree

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,3 +52,4 @@ Temporary Items
5252
.apdisk
5353

5454
schedule-maker-test.svg
55+
*.ics

‎schedules.xlsx‎

3.66 KB
Binary file not shown.

‎src/CmdLineOpts.hs‎

Lines changed: 10 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE LambdaCase #-}
22

3-
module CmdLineOpts (options, Options (..), execParser, ExampleYamlLanguage (..),) where
3+
module CmdLineOpts (options, Options (..), execParser, ExampleYamlLanguage (..)) where
44

55
import Options.Applicative
66

@@ -9,7 +9,7 @@ data Options
99
!FilePath -- yamlSource
1010
!Bool -- prettyPrintToStdout
1111
!FilePath -- outputFilePath
12-
!(Maybe FilePath) -- create *.ical schedule
12+
!Bool -- create *.ical schedule
1313
| PrintExampleYaml !ExampleYamlLanguage -- True english, False spanish
1414

1515
data ExampleYamlLanguage
@@ -33,7 +33,7 @@ options =
3333
opts = languageParser <|> normalOpts
3434

3535
normalOpts :: Parser Options
36-
normalOpts = NormalOptions <$> yamlPath <*> prettyPrintStdout <*> outputPath <*> icalPath
36+
normalOpts = NormalOptions <$> yamlPath <*> prettyPrintStdout <*> outputPath <*> writeICal
3737

3838
languageParser :: Parser Options
3939
languageParser =
@@ -81,22 +81,10 @@ outputPath =
8181
<> short 'o'
8282
)
8383

84-
icalPath :: Parser (Maybe FilePath)
85-
icalPath = optional first <|> second
86-
where first =
87-
strOption
88-
( metavar "FILENAME"
89-
<> help "Write output to FILE (.ical)"
90-
<> action "directory"
91-
<> action "file"
92-
<> long "ical"
93-
<> short 'i'
94-
)
95-
second =
96-
flag Nothing (Just "schedules.ical")
97-
(
98-
help "Write output to FILE (.ical)"
99-
<> long "ical"
100-
<> short 'i'
101-
102-
)
84+
writeICal :: Parser Bool
85+
writeICal =
86+
switch
87+
( help "Write the schedules to iCal files (schedule1.ics, schedule2.ics)"
88+
<> long "ical"
89+
<> short 'i'
90+
)

‎src/PPrint.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,8 +57,8 @@ separateWith lineStyle lineChar numOfLines l r = l <> emptyLines <> separatingLi
5757
annotateErrors :: [Error] -> Doc AnsiStyle
5858
annotateErrors es =
5959
annotate
60-
(color Red <> bold)
61-
(concatWith (separateWith bold '-' 1) (map annotateError es))
60+
(color Red <> bold) $
61+
concatWith (separateWith bold '-' 1) (map annotateError es) <> line
6262

6363
annotateSubjectList :: [IDandSubj] -> Doc AnsiStyle
6464
annotateSubjectList ss = concatWith (separateWith (colorDull Yellow) '-' 1) (map annotateSubject ss)

‎src/Validation.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import System.Console.Terminal.Size
1717
import System.IO (stdout)
1818
import Types
1919
import WriteXlsx (saveExcel)
20-
import WriteiCal (saveICal)
20+
import WriteiCal (saveMultipleICals)
2121

2222
intervalsOverlap :: Interval -> Interval -> Bool
2323
intervalsOverlap (MkInterval a b) (MkInterval x y)
@@ -124,7 +124,7 @@ collectValidationResults xs = do
124124
runProgLogic :: Options -> IO ()
125125
runProgLogic = \case
126126
PrintExampleYaml lang -> printYaml lang
127-
NormalOptions yamlSource prettyPrintToStdout outputFilePath mayICalFilePath -> do
127+
NormalOptions yamlSource prettyPrintToStdout outputFilePath writeICals -> do
128128
res <- decodeFileEither yamlSource -- "test-english.yaml"
129129
sz <-
130130
size >>= \case
@@ -141,5 +141,6 @@ runProgLogic = \case
141141
Right lists -> do
142142
when prettyPrintToStdout $ prettyRender (annotateSubjectLists lists)
143143

144-
maybe (pure ()) (saveICal lists) mayICalFilePath
144+
when writeICals $ saveMultipleICals lists
145+
145146
saveExcel lists outputFilePath

‎src/WriteiCal.hs‎

Lines changed: 66 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
11
{-# LANGUAGE OverloadedRecordDot #-}
22
{-# LANGUAGE OverloadedStrings #-}
33

4-
module WriteiCal (saveICal) where
4+
module WriteiCal (saveMultipleICals) where
55

66
import Data.ByteString.Lazy.Char8 qualified as BSL
77
import Data.Default
8+
import Data.Foldable (traverse_)
89
import Data.Function ((&))
910
import Data.Map.Strict as M
1011
import Data.Text qualified as TS
@@ -54,49 +55,65 @@ emptyVEvent =
5455
veOther = def
5556
}
5657

57-
toVCal :: Day -> [IDandSubj] -> VCalendar
58-
toVCal weekStartDay subjects =
59-
emptyVCalendar
60-
{ vcEvents = vEventMap
61-
}
58+
toVCal :: Day -> [IDandSubj] -> IO VCalendar
59+
toVCal weekStartDay subjects = do
60+
emap <- vEventMap
61+
pure $
62+
emptyVCalendar
63+
{ vcEvents = emap
64+
}
6265
where
63-
vEventMap :: Map (TL.Text, Maybe (Either Date DateTime)) VEvent
64-
vEventMap = ((\(txt, ev) -> ((txt, Nothing), ev)) <$> vEventList) & M.fromList
66+
vEventMap :: IO (Map (TL.Text, Maybe (Either Date DateTime)) VEvent)
67+
vEventMap = do
68+
elist <- vEventList
69+
pure $ ((\(txt, ev) -> ((txt, Nothing), ev)) <$> elist) & M.fromList
6570

66-
vEventList :: [(TL.Text, VEvent)]
67-
vEventList = concatMap idandsubjToVEvents subjects
71+
vEventList :: IO [(TL.Text, VEvent)]
72+
vEventList = concat <$> traverse idandsubjToVEvents subjects
6873

69-
idandsubjToVEvents :: IDandSubj -> [(TL.Text, VEvent)]
70-
idandsubjToVEvents (IDandSubj (subId, subj)) = fmap (classToEvent subId subj.subjName subj.subjProfessor) subj.subjclasses
74+
idandsubjToVEvents :: IDandSubj -> IO [(TL.Text, VEvent)]
75+
idandsubjToVEvents (IDandSubj (subId, subj)) = traverse (classToEvent subId subj.subjName subj.subjProfessor) subj.subjclasses
7176

72-
classToEvent :: TS.Text -> TS.Text -> TS.Text -> Class -> (TL.Text, VEvent) -- T.Text: UID value
73-
classToEvent subId name teacher individualClass =
74-
( uidText,
75-
emptyVEvent
76-
{ veSummary =
77-
Just $
78-
Summary
79-
{ summaryValue = TL.fromStrict (name <> "(" <> subId <> ")"),
80-
summaryLanguage = def,
81-
summaryAltRep = def,
82-
summaryOther = def
83-
},
84-
veUID = UID uidText def,
85-
veDTStart = Just startDatetime,
86-
veDTEndDuration = Just $ Left endDatetime,
87-
veDescription =
88-
Just $
89-
Description
90-
{ descriptionValue = TL.fromStrict teacher,
91-
descriptionLanguage = def,
92-
descriptionAltRep = def,
93-
descriptionOther = def
94-
}
95-
}
96-
)
77+
classToEvent :: TS.Text -> TS.Text -> TS.Text -> Class -> IO (TL.Text, VEvent) -- T.Text: UID value
78+
classToEvent subId name teacher individualClass = do
79+
uidText <- getUidText
80+
pure $
81+
( uidText,
82+
emptyVEvent
83+
{ veSummary =
84+
Just $
85+
Summary
86+
{ summaryValue = TL.fromStrict (name <> "(" <> subId <> ")"),
87+
summaryLanguage = def,
88+
summaryAltRep = def,
89+
summaryOther = def
90+
},
91+
veUID = UID uidText def,
92+
veDTStart = Just startDatetime,
93+
veDTEndDuration = Just $ Left endDatetime,
94+
veDescription =
95+
Just $
96+
Description
97+
{ descriptionValue = TL.fromStrict teacher,
98+
descriptionLanguage = def,
99+
descriptionAltRep = def,
100+
descriptionOther = def
101+
}
102+
}
103+
)
97104
where
98-
uidText :: TL.Text
99-
uidText = TL.fromStrict subId <> TL.pack (show $ getClassDayOffset individualClass)
105+
getUidText :: IO TL.Text
106+
getUidText = do
107+
time <- TL.pack . show <$> getSystemTime
108+
let res =
109+
TL.fromStrict subId
110+
<> "-"
111+
<> TL.replace " " "_" (TL.fromStrict name)
112+
<> "-"
113+
<> TL.pack (show $ getClassDayOffset individualClass)
114+
<> "-"
115+
<> time
116+
pure res
100117

101118
dayOfClass :: Day
102119
dayOfClass = addDays (getClassDayOffset individualClass) weekStartDay
@@ -136,11 +153,19 @@ renderICal :: [IDandSubj] -> IO BSL.ByteString
136153
renderICal idAndSubj = do
137154
(LocalTime today _) <- getLocalTime
138155
let nextMonday = addDays 1 $ sundayAfter today
139-
let vcal = toVCal nextMonday idAndSubj
156+
vcal <- toVCal nextMonday idAndSubj
140157
pure $ printICalendar def vcal
141158

142-
143159
saveICal :: [IDandSubj] -> FilePath -> IO ()
144160
saveICal idAndSubj filepath = do
145161
renderedICal <- renderICal idAndSubj
146162
BSL.writeFile filepath renderedICal
163+
164+
saveMultipleICals :: [[IDandSubj]] -> IO ()
165+
saveMultipleICals schedules = traverse_ (uncurry saveICal) schedulesWithNames
166+
where
167+
joinLists :: [IDandSubj] -> Int -> ([IDandSubj], FilePath)
168+
joinLists singleSchedule scheduleNumber = (singleSchedule, "schedule" <> show scheduleNumber <> ".ics")
169+
170+
schedulesWithNames :: [([IDandSubj], FilePath)]
171+
schedulesWithNames = zipWith joinLists schedules [1 ..]

‎stack.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ ghc-options:
4444
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
4545
#
4646
extra-deps:
47-
- git: git@github.com:0rphee/iCalendar.git
47+
- git: https://github.com/0rphee/iCalendar.git
4848
commit: "b31ccf7c1f68532f5c6beb0e50128290fa5d03f3"
4949
- mime-0.4.0.2@sha256:208947d9d1a19d08850be67ecb28c6e776db697f3bba05bd9d682e51a59f241f,983
5050

‎stack.yaml.lock‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,15 +6,15 @@
66
packages:
77
- completed:
88
commit: b31ccf7c1f68532f5c6beb0e50128290fa5d03f3
9-
git: git@github.com:0rphee/iCalendar.git
9+
git: https://github.com/0rphee/iCalendar.git
1010
name: iCalendar
1111
pantry-tree:
1212
sha256: 3c93da66cbb54febeadf033a3153f08ffb90b951b67e7b513a2ba052bc7646a1
1313
size: 1026
1414
version: 0.4.0.5
1515
original:
1616
commit: b31ccf7c1f68532f5c6beb0e50128290fa5d03f3
17-
git: git@github.com:0rphee/iCalendar.git
17+
git: https://github.com/0rphee/iCalendar.git
1818
- completed:
1919
hackage: mime-0.4.0.2@sha256:208947d9d1a19d08850be67ecb28c6e776db697f3bba05bd9d682e51a59f241f,983
2020
pantry-tree:

0 commit comments

Comments
 (0)