diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Postdelay/PrioMap.hs | 5 | ||||
-rw-r--r-- | lib/Postdelay/TimeSpec.hs | 36 |
2 files changed, 19 insertions, 22 deletions
diff --git a/lib/Postdelay/PrioMap.hs b/lib/Postdelay/PrioMap.hs index 2b75984..97705ba 100644 --- a/lib/Postdelay/PrioMap.hs +++ b/lib/Postdelay/PrioMap.hs | |||
@@ -2,7 +2,7 @@ | |||
2 | 2 | ||
3 | module Postdelay.PrioMap | 3 | module Postdelay.PrioMap |
4 | ( PrioMap, prioMap, prioMap', _Endo | 4 | ( PrioMap, prioMap, prioMap', _Endo |
5 | , prio, prios | 5 | , prio, prio', prios |
6 | , squash | 6 | , squash |
7 | 7 | ||
8 | , PrioEndo, prioEndo, prioEndo' | 8 | , PrioEndo, prioEndo, prioEndo' |
@@ -68,3 +68,6 @@ prioEndo = prioMap | |||
68 | 68 | ||
69 | prioEndo' :: Enum p => p -> Iso' (PrioEndo p a) (Endo a) | 69 | prioEndo' :: Enum p => p -> Iso' (PrioEndo p a) (Endo a) |
70 | prioEndo' = prioMap' | 70 | prioEndo' = prioMap' |
71 | |||
72 | prio' :: Enum p => p -> Setter' (PrioEndo p a) a | ||
73 | prio' p = sets $ \(Endo -> mod) -> mappend $ review (prioMap' p) mod | ||
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 | ||
61 | mod' :: ModPrio -> ASetter' LocalTime a -> a -> PrioEndo ModPrio LocalTime | ||
62 | mod' priority setter val = mempty & prio priority .~ (Just . Endo $ set setter val) | ||
63 | |||
64 | scribeMod :: MonadWriter (PrioEndo ModPrio LocalTime) m => ModPrio -> ASetter' LocalTime a -> a -> m () | ||
65 | scribeMod priority setter val = tell $ mod' priority setter val | ||
66 | |||
67 | |||
68 | timeSpec :: forall s m. StringParser s m => m (Endo LocalTime) | 61 | timeSpec :: forall s m. StringParser s m => m (Endo LocalTime) |
69 | timeSpec = label "Relative time specification" $ view prioEndo <$> choice | 62 | timeSpec = 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 | ||
114 | dateSpec = label "Date" $ choice | 108 | dateSpec = 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 | ||