summaryrefslogtreecommitdiff
path: root/lib/Postdelay/TimeSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Postdelay/TimeSpec.hs')
-rw-r--r--lib/Postdelay/TimeSpec.hs36
1 files changed, 15 insertions, 21 deletions
diff --git a/lib/Postdelay/TimeSpec.hs b/lib/Postdelay/TimeSpec.hs
index 454f704..c2ddc3f 100644
--- a/lib/Postdelay/TimeSpec.hs
+++ b/lib/Postdelay/TimeSpec.hs
@@ -58,13 +58,6 @@ shiftBack by mod@(view (prioEndo._Endo) -> modE) = do
58 True -> scribe (prio Shift) . Just . Endo $ flexDT.seconds' %~ ((^+^) by) 58 True -> scribe (prio Shift) . Just . Endo $ flexDT.seconds' %~ ((^+^) by)
59 False -> return () 59 False -> return ()
60 60
61mod' :: ModPrio -> ASetter' LocalTime a -> a -> PrioEndo ModPrio LocalTime
62mod' priority setter val = mempty & prio priority .~ (Just . Endo $ set setter val)
63
64scribeMod :: MonadWriter (PrioEndo ModPrio LocalTime) m => ModPrio -> ASetter' LocalTime a -> a -> m ()
65scribeMod priority setter val = tell $ mod' priority setter val
66
67
68timeSpec :: forall s m. StringParser s m => m (Endo LocalTime) 61timeSpec :: forall s m. StringParser s m => m (Endo LocalTime)
69timeSpec = label "Relative time specification" $ view prioEndo <$> choice 62timeSpec = label "Relative time specification" $ view prioEndo <$> choice
70 [ flip (<>) <$> lexeme specBase <*> option mempty (offsets True) 63 [ flip (<>) <$> lexeme specBase <*> option mempty (offsets True)
@@ -110,30 +103,31 @@ timeOfDay = label "Time of day" $ withShift <$> choice
110 103
111 withShift :: TimeOfDay -> RWS LocalTime (PrioEndo ModPrio LocalTime) () () 104 withShift :: TimeOfDay -> RWS LocalTime (PrioEndo ModPrio LocalTime) () ()
112 withShift = shiftBack (1 % Day) . mod' Assign time 105 withShift = shiftBack (1 % Day) . mod' Assign time
106 mod' priority setter val = mempty & prio priority .~ (Just . Endo $ set setter val)
113 107
114dateSpec = label "Date" $ choice 108dateSpec = label "Date" $ choice
115 [ (scribeMod Assign date =<< view date) <$ string' "today" 109 [ (scribe (prio' Assign . date) =<< view date) <$ string' "today"
116 , (scribeMod Assign date =<< views date succ) <$ string' "tomorrow" 110 , (scribe (prio' Assign . date) =<< views date succ) <$ string' "tomorrow"
117 , do 111 , do
118 string' "next" 112 string' "next"
119 spaces 113 spaces
120 choice 114 choice
121 [ string' "day" $> do 115 [ string' "day" $> do
122 scribeMod Assign (flexDT.date.days) =<< views (date.days) succ 116 scribe (prio' Assign . flexDT.date.days) =<< views (date.days) succ
123 scribeMod Default time midnight 117 scribe (prio' Default . time) midnight
124 , string' "week" $> do 118 , string' "week" $> do
125 scribeMod Assign (flexDT.date.days) =<< views (date.days) (+ 7) 119 scribe (prio' Assign . flexDT.date.days) =<< views (date.days) (+ 7)
126 scribeMod Assign (weekDate._3) 1 120 scribe (prio' Assign . weekDate._3) 1
127 scribeMod Default time midnight 121 scribe (prio' Default . time) midnight
128 , string' "month" $> do 122 , string' "month" $> do
129 scribeMod Assign (flexDT.date.months) =<< views (date.months) succ 123 scribe (prio' Assign . flexDT.date.months) =<< views (date.months) succ
130 scribeMod Assign (date.days) 1 124 scribe (prio' Assign . date.days) 1
131 scribeMod Default time midnight 125 scribe (prio' Default . time) midnight
132 , string' "year" $> do 126 , string' "year" $> do
133 scribeMod Assign (flexDT.date.years) =<< views (date.years) succ 127 scribe (prio' Assign . flexDT.date.years) =<< views (date.years) succ
134 scribeMod Assign (date.months) 1 128 scribe (prio' Assign . date.months) 1
135 scribeMod Assign (date.days) 1 129 scribe (prio' Assign . date.days) 1
136 scribeMod Default time midnight 130 scribe (prio' Default . time) midnight
137 ] 131 ]
138 ] 132 ]
139 133