Minor cleanup

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 @@
 
 module Postdelay.PrioMap
   ( PrioMap, prioMap, prioMap', _Endo
-  , prio, prios
+  , prio, prio', prios
   , squash
 
   , PrioEndo, prioEndo, prioEndo'
@@ -68,3 +68,6 @@ prioEndo = prioMap
 
 prioEndo' :: Enum p => p -> Iso' (PrioEndo p a) (Endo a)
 prioEndo' = prioMap'
+
+prio' :: Enum p => p -> Setter' (PrioEndo p a) a
+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
     True -> scribe (prio Shift) . Just . Endo $ flexDT.seconds' %~ ((^+^) by)
     False -> return ()
 
-mod' :: ModPrio -> ASetter' LocalTime a -> a -> PrioEndo ModPrio LocalTime
-mod' priority setter val = mempty & prio priority .~ (Just . Endo $ set setter val)
-
-scribeMod :: MonadWriter (PrioEndo ModPrio LocalTime) m => ModPrio -> ASetter' LocalTime a -> a -> m ()
-scribeMod priority setter val = tell $ mod' priority setter val
-
-
 timeSpec :: forall s m. StringParser s m => m (Endo LocalTime)
 timeSpec = label "Relative time specification" $ view prioEndo <$> choice
            [ flip (<>) <$> lexeme specBase <*> option mempty (offsets True)
@@ -110,30 +103,31 @@ timeOfDay = label "Time of day" $ withShift <$> choice
 
     withShift :: TimeOfDay -> RWS LocalTime (PrioEndo ModPrio LocalTime) () ()
     withShift = shiftBack (1 % Day) . mod' Assign time
+    mod' priority setter val = mempty & prio priority .~ (Just . Endo $ set setter val)
     
 dateSpec = label "Date" $ choice
-           [ (scribeMod Assign date =<< view date) <$ string' "today"
-           , (scribeMod Assign date =<< views date succ) <$ string' "tomorrow"
+           [ (scribe (prio' Assign . date) =<< view date) <$ string' "today"
+           , (scribe (prio' Assign . date) =<< views date succ) <$ string' "tomorrow"
            , do
                string' "next"
                spaces
                choice
                  [ string' "day" $> do
-                     scribeMod Assign (flexDT.date.days) =<< views (date.days) succ
-                     scribeMod Default time midnight
+                     scribe (prio' Assign . flexDT.date.days) =<< views (date.days) succ
+                     scribe (prio' Default . time) midnight
                  , string' "week" $> do
-                     scribeMod Assign (flexDT.date.days) =<< views (date.days) (+ 7)
-                     scribeMod Assign (weekDate._3) 1
-                     scribeMod Default time midnight
+                     scribe (prio' Assign . flexDT.date.days) =<< views (date.days) (+ 7)
+                     scribe (prio' Assign . weekDate._3) 1
+                     scribe (prio' Default . time) midnight
                  , string' "month" $> do
-                     scribeMod Assign (flexDT.date.months) =<< views (date.months) succ
-                     scribeMod Assign (date.days) 1
-                     scribeMod Default time midnight
+                     scribe (prio' Assign . flexDT.date.months) =<< views (date.months) succ
+                     scribe (prio' Assign . date.days) 1
+                     scribe (prio' Default . time) midnight
                  , string' "year" $> do
-                     scribeMod Assign (flexDT.date.years) =<< views (date.years) succ
-                     scribeMod Assign (date.months) 1
-                     scribeMod Assign (date.days) 1
-                     scribeMod Default time midnight
+                     scribe (prio' Assign . flexDT.date.years) =<< views (date.years) succ
+                     scribe (prio' Assign . date.months) 1
+                     scribe (prio' Assign . date.days) 1
+                     scribe (prio' Default . time) midnight
                  ]
            ]