-- Copyright (C) 2004 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

-- |
-- Module      : Darcs.Util.DateMatcher
-- Copyright   : 2004 David Roundy
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable

module Darcs.Util.DateMatcher
    (
      parseDateMatcher
    -- for debugging only
    , DateMatcher(..)
    , getMatchers
    -- for testing (GHCi, etc)
    , testDate
    , testDateAt
    ) where

import Darcs.Prelude

import Control.Exception ( catchJust )
import Data.Maybe ( isJust )

import System.IO.Error ( isUserError, ioeGetErrorString )
import System.Time
import Text.ParserCombinators.Parsec ( eof, parse, ParseError )

import Darcs.Util.IsoDate
    ( parseDate, englishDateTime, englishInterval, englishLast
    , iso8601Interval, resetCalendar, subtractFromMCal, getLocalTz
    , MCalendarTime(..), toMCalendarTime, unsafeToCalendarTime
    , unsetTime, readUTCDate
    )

-- | 'withinDay' @x y@ is true if @x <= y < (x + one_day)@
-- Note that this converts the two dates to @ClockTime@ to avoid
-- any timezone-related errors
withinDay :: CalendarTime -> CalendarTime -> Bool
withinDay :: CalendarTime -> CalendarTime -> Bool
withinDay CalendarTime
a CalendarTime
b = Maybe ClockTime -> Maybe ClockTime -> ClockTime -> Bool
within (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just (ClockTime -> Maybe ClockTime) -> ClockTime -> Maybe ClockTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> ClockTime
toClockTime CalendarTime
a)
                       (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just (TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
day (ClockTime -> ClockTime) -> ClockTime -> ClockTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> ClockTime
toClockTime CalendarTime
a))
                       (CalendarTime -> ClockTime
toClockTime CalendarTime
b)
  where
    day :: TimeDiff
day = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Integer
0

-- | 'dateRange' @x1 x2 y@ is true if @x1 <= y < x2@
--   Since @x1@ and @x2@ can be underspecified, we simply assume the
--   first date that they could stand for.
dateRange :: Maybe MCalendarTime -> Maybe MCalendarTime -> CalendarTime -> Bool
dateRange :: Maybe MCalendarTime -> Maybe MCalendarTime -> CalendarTime -> Bool
dateRange Maybe MCalendarTime
a Maybe MCalendarTime
b = Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool
cDateRange ((MCalendarTime -> CalendarTime)
-> Maybe MCalendarTime -> Maybe CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MCalendarTime -> CalendarTime
unsafeToCalendarTime Maybe MCalendarTime
a)
                           ((MCalendarTime -> CalendarTime)
-> Maybe MCalendarTime -> Maybe CalendarTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MCalendarTime -> CalendarTime
unsafeToCalendarTime Maybe MCalendarTime
b)

-- | 'cDateRange' @x1 x2 y@ is true if @x1 <= y < x2@
cDateRange :: Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool
cDateRange :: Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool
cDateRange Maybe CalendarTime
a Maybe CalendarTime
b CalendarTime
c = Maybe ClockTime -> Maybe ClockTime -> ClockTime -> Bool
within ((CalendarTime -> ClockTime)
-> Maybe CalendarTime -> Maybe ClockTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarTime -> ClockTime
toClockTime Maybe CalendarTime
a)
                          ((CalendarTime -> ClockTime)
-> Maybe CalendarTime -> Maybe ClockTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarTime -> ClockTime
toClockTime Maybe CalendarTime
b) (CalendarTime -> ClockTime
toClockTime CalendarTime
c)

-- | 'within' @x1 x2 y@ is true if @x1 <= y < x2@
within :: Maybe ClockTime -> Maybe ClockTime -> ClockTime -> Bool
within :: Maybe ClockTime -> Maybe ClockTime -> ClockTime -> Bool
within (Just ClockTime
start) (Just ClockTime
end) ClockTime
time = ClockTime
start ClockTime -> ClockTime -> Bool
forall a. Ord a => a -> a -> Bool
<= ClockTime
time Bool -> Bool -> Bool
&& ClockTime
time ClockTime -> ClockTime -> Bool
forall a. Ord a => a -> a -> Bool
< ClockTime
end
within Maybe ClockTime
Nothing (Just ClockTime
end) ClockTime
time = ClockTime
time ClockTime -> ClockTime -> Bool
forall a. Ord a => a -> a -> Bool
< ClockTime
end
within (Just ClockTime
start) Maybe ClockTime
Nothing ClockTime
time = ClockTime
start ClockTime -> ClockTime -> Bool
forall a. Ord a => a -> a -> Bool
<= ClockTime
time
within Maybe ClockTime
_ Maybe ClockTime
_ ClockTime
_ = Bool
forall a. HasCallStack => a
undefined

-- | 'samePartialDate' @range exact@ is true if @exact@ falls
--   within the a range of dates represented by @range@.
--   The purpose of this function is to support matching on partially
--   specified dates.  That is, if you only specify the date 2007,
--   this function should match any dates within that year.  On the
--   other hand, if you specify 2007-01, this function will match any
--   dates within that month.  This function only matches up to the
--   second.
samePartialDate :: MCalendarTime -> CalendarTime -> Bool
samePartialDate :: MCalendarTime -> CalendarTime -> Bool
samePartialDate MCalendarTime
a CalendarTime
b_ =
    Maybe ClockTime -> Maybe ClockTime -> ClockTime -> Bool
within (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just ClockTime
clockA)
           (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just (ClockTime -> Maybe ClockTime) -> ClockTime -> Maybe ClockTime
forall a b. (a -> b) -> a -> b
$ TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
interval ClockTime
clockA)
           (CalendarTime -> ClockTime
toClockTime CalendarTime
calB)
  where
    interval :: TimeDiff
interval
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Int
mctSec MCalendarTime
a)   = TimeDiff
second
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Int
mctMin MCalendarTime
a)   = TimeDiff
minute
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Int
mctHour MCalendarTime
a)  = TimeDiff
hour
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Int
mctYDay MCalendarTime
a)  = TimeDiff
day
        | MCalendarTime -> Bool
mctWeek MCalendarTime
a = TimeDiff -> (Day -> TimeDiff) -> Maybe Day -> TimeDiff
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TimeDiff
week (TimeDiff -> Day -> TimeDiff
forall a b. a -> b -> a
const TimeDiff
day) (MCalendarTime -> Maybe Day
mctWDay MCalendarTime
a)
        | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Int
mctDay MCalendarTime
a)   = TimeDiff
day
        | Maybe Month -> Bool
forall a. Maybe a -> Bool
isJust (MCalendarTime -> Maybe Month
mctMonth MCalendarTime
a) = TimeDiff
month
        | Bool
otherwise           = TimeDiff
year
    year :: TimeDiff
year   = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
1 Int
0 Int
0 Int
0 Int
0 Int
0 Integer
0
    month :: TimeDiff
month  = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
1 Int
0 Int
0 Int
0 Int
0 Integer
0
    week :: TimeDiff
week   = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
7 Int
0 Int
0 Int
0 Integer
0
    day :: TimeDiff
day    = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
1 Int
0 Int
0 Int
0 Integer
0
    hour :: TimeDiff
hour   = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
0 Int
1 Int
0 Int
0 Integer
0
    minute :: TimeDiff
minute = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
0 Int
0 Int
1 Int
0 Integer
0
    second :: TimeDiff
second = Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
0 Int
0 Int
0 Int
1 Integer
0
    clockA :: ClockTime
clockA = CalendarTime -> ClockTime
toClockTime (CalendarTime -> ClockTime) -> CalendarTime -> ClockTime
forall a b. (a -> b) -> a -> b
$ MCalendarTime -> CalendarTime
unsafeToCalendarTime MCalendarTime
a
    calB :: CalendarTime
calB   = CalendarTime -> CalendarTime
resetCalendar CalendarTime
b_

-- | A 'DateMatcher' combines a potential parse for a date string
--   with a "matcher" function that operates on a given date.
--   We use an existential type on the matcher to allow
--   the date string to either be interpreted as a point in time
--   or as an interval.
data DateMatcher = forall d . (Show d) => DM
    String                      --  name
    (Either ParseError d)       --  parser
    (d -> CalendarTime -> Bool) --  matcher

-- | 'parseDateMatcher' @s@ return the first  matcher in
--    'getMatchers' that can parse 's'
parseDateMatcher :: String -> IO (CalendarTime -> Bool)
parseDateMatcher :: String -> IO (CalendarTime -> Bool)
parseDateMatcher String
d = IO (CalendarTime -> Bool)
testDateMatcher IO (CalendarTime -> Bool)
-> (String -> IO (CalendarTime -> Bool))
-> IO (CalendarTime -> Bool)
forall a. IO a -> (String -> IO a) -> IO a
`catchUserError` String -> IO (CalendarTime -> Bool)
forall p. String -> p
handleError
  where
    catchUserError :: IO a -> (String -> IO a) -> IO a
catchUserError = (IOError -> Maybe String) -> IO a -> (String -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust ((IOError -> Maybe String) -> IO a -> (String -> IO a) -> IO a)
-> (IOError -> Maybe String) -> IO a -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
        if IOError -> Bool
isUserError IOError
e then String -> Maybe String
forall a. a -> Maybe a
Just (IOError -> String
ioeGetErrorString IOError
e) else Maybe String
forall a. Maybe a
Nothing

    -- If the user enters a date > maxint seconds ago, the toClockTime
    -- function cannot work.
    handleError :: String -> p
handleError String
e = if String
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Time.toClockTime: invalid input"
                        then String -> p
forall a. HasCallStack => String -> a
error String
"Can't handle dates that far back!"
                        else String -> p
forall a. HasCallStack => String -> a
error String
e

    -- Hack: test the matcher against the current date and discard the results.
    -- We just want to make sure it won't throw any exceptions when we use it
    -- for real.
    testDateMatcher :: IO (CalendarTime -> Bool)
testDateMatcher = do
        CalendarTime -> Bool
matcher <- [DateMatcher] -> CalendarTime -> Bool
tryMatchers ([DateMatcher] -> CalendarTime -> Bool)
-> IO [DateMatcher] -> IO (CalendarTime -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [DateMatcher]
getMatchers String
d
        CalendarTime -> Bool
matcher (CalendarTime -> Bool) -> IO CalendarTime -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO CalendarTime
now IO Bool
-> (Bool -> IO (CalendarTime -> Bool)) -> IO (CalendarTime -> Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO (CalendarTime -> Bool) -> IO (CalendarTime -> Bool)
`seq` (CalendarTime -> Bool) -> IO (CalendarTime -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return CalendarTime -> Bool
matcher)

-- | 'getMatchers' @d@ returns the list of matchers that will be
--   applied on @d@.  If you wish to extend the date parsing code,
--   this will likely be the function that you modify to do so.
getMatchers :: String -> IO [DateMatcher]
getMatchers :: String -> IO [DateMatcher]
getMatchers String
d = do
    CalendarTime
rightNow <- IO CalendarTime
now
    let midnightToday :: CalendarTime
midnightToday = CalendarTime -> CalendarTime
unsetTime CalendarTime
rightNow
        mRightNow :: MCalendarTime
mRightNow = CalendarTime -> MCalendarTime
toMCalendarTime CalendarTime
rightNow
        matchIsoInterval :: Either TimeDiff (MCalendarTime, MCalendarTime)
-> CalendarTime -> Bool
matchIsoInterval (Left TimeDiff
dur) =
            let durAgo :: MCalendarTime
durAgo = TimeDiff
dur TimeDiff -> MCalendarTime -> MCalendarTime
`subtractFromMCal` MCalendarTime
mRightNow in
            Maybe MCalendarTime -> Maybe MCalendarTime -> CalendarTime -> Bool
dateRange (MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just MCalendarTime
durAgo) (MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just MCalendarTime
mRightNow)
        matchIsoInterval (Right (MCalendarTime
a,MCalendarTime
b)) = Maybe MCalendarTime -> Maybe MCalendarTime -> CalendarTime -> Bool
dateRange (MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just MCalendarTime
a) (MCalendarTime -> Maybe MCalendarTime
forall a. a -> Maybe a
Just MCalendarTime
b)
    Int
tzNow <- IO Int
getLocalTz
    [DateMatcher] -> IO [DateMatcher]
forall (m :: * -> *) a. Monad m => a -> m a
return
        -- note that the order of these is quite important as some matchers can
        -- match the same date.
        [ String
-> Either ParseError (CalendarTime, CalendarTime)
-> ((CalendarTime, CalendarTime) -> CalendarTime -> Bool)
-> DateMatcher
forall d.
Show d =>
String
-> Either ParseError d
-> (d -> CalendarTime -> Bool)
-> DateMatcher
DM String
"from English date"
              (ParsecT String () Identity (CalendarTime, CalendarTime)
-> Either ParseError (CalendarTime, CalendarTime)
forall a. ParsecT String () Identity a -> Either ParseError a
parseDateWith (ParsecT String () Identity (CalendarTime, CalendarTime)
 -> Either ParseError (CalendarTime, CalendarTime))
-> ParsecT String () Identity (CalendarTime, CalendarTime)
-> Either ParseError (CalendarTime, CalendarTime)
forall a b. (a -> b) -> a -> b
$ CalendarTime
-> ParsecT String () Identity (CalendarTime, CalendarTime)
forall a. CalendarTime -> CharParser a (CalendarTime, CalendarTime)
englishLast CalendarTime
midnightToday)
              (\(CalendarTime
a,CalendarTime
_) -> Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool
cDateRange (CalendarTime -> Maybe CalendarTime
forall a. a -> Maybe a
Just CalendarTime
a) Maybe CalendarTime
forall a. Maybe a
Nothing)
        , String
-> Either ParseError CalendarTime
-> (CalendarTime -> CalendarTime -> Bool)
-> DateMatcher
forall d.
Show d =>
String
-> Either ParseError d
-> (d -> CalendarTime -> Bool)
-> DateMatcher
DM String
"specific English date"
              (ParsecT String () Identity CalendarTime
-> Either ParseError CalendarTime
forall a. ParsecT String () Identity a -> Either ParseError a
parseDateWith (ParsecT String () Identity CalendarTime
 -> Either ParseError CalendarTime)
-> ParsecT String () Identity CalendarTime
-> Either ParseError CalendarTime
forall a b. (a -> b) -> a -> b
$ CalendarTime -> ParsecT String () Identity CalendarTime
forall a. CalendarTime -> CharParser a CalendarTime
englishDateTime CalendarTime
midnightToday)
              CalendarTime -> CalendarTime -> Bool
withinDay
        , String
-> Either ParseError TimeInterval
-> (TimeInterval -> CalendarTime -> Bool)
-> DateMatcher
forall d.
Show d =>
String
-> Either ParseError d
-> (d -> CalendarTime -> Bool)
-> DateMatcher
DM String
"English interval"
              (ParsecT String () Identity TimeInterval
-> Either ParseError TimeInterval
forall a. ParsecT String () Identity a -> Either ParseError a
parseDateWith (ParsecT String () Identity TimeInterval
 -> Either ParseError TimeInterval)
-> ParsecT String () Identity TimeInterval
-> Either ParseError TimeInterval
forall a b. (a -> b) -> a -> b
$ CalendarTime -> ParsecT String () Identity TimeInterval
forall a. CalendarTime -> CharParser a TimeInterval
englishInterval CalendarTime
rightNow)
              ((Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool)
-> TimeInterval -> CalendarTime -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe CalendarTime -> Maybe CalendarTime -> CalendarTime -> Bool
cDateRange)
        , String
-> Either
     ParseError (Either TimeDiff (MCalendarTime, MCalendarTime))
-> (Either TimeDiff (MCalendarTime, MCalendarTime)
    -> CalendarTime -> Bool)
-> DateMatcher
forall d.
Show d =>
String
-> Either ParseError d
-> (d -> CalendarTime -> Bool)
-> DateMatcher
DM String
"ISO 8601 interval"
              (ParsecT
  String () Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
-> Either
     ParseError (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a. ParsecT String () Identity a -> Either ParseError a
parseDateWith (ParsecT
   String () Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
 -> Either
      ParseError (Either TimeDiff (MCalendarTime, MCalendarTime)))
-> ParsecT
     String () Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
-> Either
     ParseError (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT
     String () Identity (Either TimeDiff (MCalendarTime, MCalendarTime))
forall a.
Int
-> CharParser a (Either TimeDiff (MCalendarTime, MCalendarTime))
iso8601Interval Int
tzNow)
              Either TimeDiff (MCalendarTime, MCalendarTime)
-> CalendarTime -> Bool
matchIsoInterval
        , String
-> Either ParseError MCalendarTime
-> (MCalendarTime -> CalendarTime -> Bool)
-> DateMatcher
forall d.
Show d =>
String
-> Either ParseError d
-> (d -> CalendarTime -> Bool)
-> DateMatcher
DM String
"CVS, ISO 8601, old style, or RFC2822 date"
              (Int -> String -> Either ParseError MCalendarTime
parseDate Int
tzNow String
d)
              MCalendarTime -> CalendarTime -> Bool
samePartialDate
        ]
  where
    tillEof :: ParsecT s u m b -> ParsecT s u m b
tillEof ParsecT s u m b
p = do { b
x <- ParsecT s u m b
p; ParsecT s u m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x }
    parseDateWith :: ParsecT String () Identity a -> Either ParseError a
parseDateWith ParsecT String () Identity a
p = ParsecT String () Identity a
-> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity a -> ParsecT String () Identity a
forall s (m :: * -> *) t u b.
(Stream s m t, Show t) =>
ParsecT s u m b -> ParsecT s u m b
tillEof ParsecT String () Identity a
p) String
"" String
d


--- The following functions are for toying around in GHCi
---
--- > testDate   "2008/05/22 10:34"
--- > testDateAt "2006-03-22 09:36" "2008/05/22 10:34"

-- | 'tryMatchers' @ms@ returns the first successful match in @ms@
--   It is an error if there are no matches
tryMatchers :: [DateMatcher] -> CalendarTime -> Bool
tryMatchers :: [DateMatcher] -> CalendarTime -> Bool
tryMatchers (DM String
_ Either ParseError d
parsed d -> CalendarTime -> Bool
matcher : [DateMatcher]
ms) =
    case Either ParseError d
parsed of
        Left ParseError
_   -> [DateMatcher] -> CalendarTime -> Bool
tryMatchers [DateMatcher]
ms
        Right  d
d -> d -> CalendarTime -> Bool
matcher d
d
tryMatchers [] = String -> CalendarTime -> Bool
forall a. HasCallStack => String -> a
error String
"Can't support fancy dates."

now :: IO CalendarTime
now :: IO CalendarTime
now = IO ClockTime
getClockTime IO ClockTime -> (ClockTime -> IO CalendarTime) -> IO CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClockTime -> IO CalendarTime
toCalendarTime

-- | 'testDate' @d@ shows the possible interpretations
--   for the date string @d@ and how they match against
--   the current date
testDate :: String -> IO ()
testDate :: String -> IO ()
testDate String
d = do CalendarTime
cnow <- IO CalendarTime
now
                CalendarTime -> String -> IO ()
testDateAtCal CalendarTime
cnow String
d

-- | 'testDate' @iso d@ shows the possible interpretations
--   for the date string @d@ and how they match against
--   the date represented by the ISO 8601 string @iso@
testDateAt :: String -> String -> IO ()
testDateAt :: String -> String -> IO ()
testDateAt String
iso = CalendarTime -> String -> IO ()
testDateAtCal (String -> CalendarTime
readUTCDate String
iso)

-- | helper function for 'testDate' and 'testDateAt'
testDateAtCal :: CalendarTime -> String -> IO ()
testDateAtCal :: CalendarTime -> String -> IO ()
testDateAtCal CalendarTime
c String
d =
 do [DateMatcher]
ms <- String -> IO [DateMatcher]
getMatchers String
d
    String -> IO ()
putStr (String -> IO ())
-> ([DateMatcher] -> String) -> [DateMatcher] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([DateMatcher] -> [String]) -> [DateMatcher] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateMatcher -> String) -> [DateMatcher] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CalendarTime -> DateMatcher -> String
showMatcher CalendarTime
c) ([DateMatcher] -> IO ()) -> [DateMatcher] -> IO ()
forall a b. (a -> b) -> a -> b
$ [DateMatcher]
ms

-- | 'showMatcher' @c dm@ tells us if @dm@ applies to
--   'CalendarTime' @c@; or if @dm@ just represents the
--   failure to parse a date, in which case @c@ is moot.
showMatcher :: CalendarTime -> DateMatcher -> String
showMatcher :: CalendarTime -> DateMatcher -> String
showMatcher CalendarTime
cnow (DM String
n Either ParseError d
p d -> CalendarTime -> Bool
m) =
   String
"==== " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ====\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
   (case Either ParseError d
p of
     Left ParseError
err -> ParseError -> String -> String
forall a. Show a => a -> String -> String
shows ParseError
err String
""
     Right d
x  -> d -> String
forall a. Show a => a -> String
show d
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show (d -> CalendarTime -> Bool
m d
x CalendarTime
cnow))