diff options
Diffstat (limited to 'lib/Postdelay/TimeSpec.hs')
-rw-r--r-- | lib/Postdelay/TimeSpec.hs | 28 |
1 files changed, 25 insertions, 3 deletions
diff --git a/lib/Postdelay/TimeSpec.hs b/lib/Postdelay/TimeSpec.hs index 5c41180..03baf85 100644 --- a/lib/Postdelay/TimeSpec.hs +++ b/lib/Postdelay/TimeSpec.hs | |||
@@ -14,16 +14,38 @@ import Text.Megaparsec | |||
14 | 14 | ||
15 | import Control.Monad.IO.Class | 15 | import Control.Monad.IO.Class |
16 | import Control.Applicative | 16 | import Control.Applicative |
17 | import Control.Lens hiding ((#)) | ||
17 | 18 | ||
18 | import Data.Semigroup | 19 | import Data.Bool |
20 | import Data.Semigroup hiding (option) | ||
19 | import Data.Monoid (Endo(..)) | 21 | import Data.Monoid (Endo(..)) |
22 | import Data.Foldable | ||
23 | import Data.VectorSpace | ||
20 | 24 | ||
21 | import Data.Time | 25 | import Data.Time |
26 | import Data.Time.Lens | ||
22 | import Data.Time.Zones | 27 | import Data.Time.Zones |
23 | 28 | ||
24 | 29 | ||
30 | seconds' :: Timeable t => Lens' t Time | ||
31 | seconds' = seconds . iso (% Second) (# Second) | ||
32 | |||
33 | |||
25 | pTimeSpec :: StringParser s m => m (Endo LocalTime) | 34 | pTimeSpec :: StringParser s m => m (Endo LocalTime) |
26 | pTimeSpec = empty | 35 | pTimeSpec = label "Relative time specification" $ |
36 | choice [ pOffsets False | ||
37 | ] | ||
38 | |||
39 | pOffsets :: forall s m. StringParser s m | ||
40 | => Bool -- ^ Require sign on first offset? | ||
41 | -> m (Endo LocalTime) | ||
42 | pOffsets (bool optSigned signed -> reqSgn) = fmap fold $ (:) <$> offset reqSgn <*> many (offset optSigned) | ||
43 | where | ||
44 | asOffset :: Time -> Endo LocalTime | ||
45 | asOffset by = Endo $ flexDT.seconds' %~ (^+^ by) | ||
46 | offset :: (m Time -> m Time) -> m (Endo LocalTime) | ||
47 | offset sgn = asOffset <$> lexeme (sgn timeLength) <?> "Time offset" | ||
27 | 48 | ||
28 | pTimeZone :: (StringParser s m, MonadIO m) => m (Either TimeZone TZ) | 49 | pTimeZone :: (StringParser s m, MonadIO m) => m (Either TimeZone TZ) |
29 | pTimeZone = empty | 50 | pTimeZone = label "Timezone" $ |
51 | empty | ||