-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Time.EN.CA.Rules
  ( rules
  ) where

import Data.Maybe
import Prelude

import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers (parseInt)
import Duckling.Regex.Types
import Duckling.Time.Helpers
import Duckling.Time.Types (TimeData (..))
import Duckling.Types
import qualified Duckling.TimeGrain.Types as TG

-- Although one can see both MMDD and DDMM in Canada,
-- there is no direct way to implement this today. Let's fallback to MMDD (US).
ruleMMDD :: Rule
ruleMMDD :: Rule
ruleMMDD = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"mm/dd"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(1[0-2]|0?[1-9])\\s?[/-]\\s?(3[01]|[12]\\d|0?[1-9])"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (mm:dd:_)):[Token]
_) -> do
        Int
m <- Text -> Maybe Int
parseInt Text
mm
        Int
d <- Text -> Maybe Int
parseInt Text
dd
        TimeData -> Maybe Token
tt (TimeData -> Maybe Token) -> TimeData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Int -> Int -> TimeData
monthDay Int
m Int
d
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleMMDDYYYY :: Rule
ruleMMDDYYYY :: Rule
ruleMMDDYYYY = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"mm/dd/yyyy"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(1[0-2]|0?[1-9])[-/\\s](3[01]|[12]\\d|0?[1-9])[-/\\s](\\d{2,4})"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (mm:dd:yy:_)):[Token]
_) -> do
        Int
y <- Text -> Maybe Int
parseInt Text
yy
        Int
m <- Text -> Maybe Int
parseInt Text
mm
        Int
d <- Text -> Maybe Int
parseInt Text
dd
        TimeData -> Maybe Token
tt (TimeData -> Maybe Token) -> TimeData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> TimeData
yearMonthDay Int
y Int
m Int
d
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

-- Clashes with HHMMSS, hence only 4-digit years
ruleMMDDYYYYDot :: Rule
ruleMMDDYYYYDot :: Rule
ruleMMDDYYYYDot = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"mm.dd.yyyy"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(1[0-2]|0?[1-9])\\.(3[01]|[12]\\d|0?[1-9])\\.(\\d{4})"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (mm:dd:yy:_)):[Token]
_) -> do
        Int
y <- Text -> Maybe Int
parseInt Text
yy
        Int
m <- Text -> Maybe Int
parseInt Text
mm
        Int
d <- Text -> Maybe Int
parseInt Text
dd
        TimeData -> Maybe Token
tt (TimeData -> Maybe Token) -> TimeData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> TimeData
yearMonthDay Int
y Int
m Int
d
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rulePeriodicHolidays :: [Rule]
rulePeriodicHolidays :: [Rule]
rulePeriodicHolidays = [(Text, String, TimeData)] -> [Rule]
mkRuleHolidays
  -- Fixed dates, year over year
  [ ( Text
"Anniversary of the Statute of Westminster", String
"anniversary of the statute of westminster", Int -> Int -> TimeData
monthDay Int
12 Int
11 )
  , ( Text
"Memorial Day", String
"(canada|dominion|memorial) day", Int -> Int -> TimeData
monthDay Int
7 Int
1 )
  , ( Text
"Groundhog Day", String
"groundhogs? day", Int -> Int -> TimeData
monthDay Int
2 Int
2 )
  , ( Text
"Healthcare Aide Day", String
"healthcare aide day", Int -> Int -> TimeData
monthDay Int
10 Int
18 )
  , ( Text
"National Aboriginal Day", String
"national aboriginal day", Int -> Int -> TimeData
monthDay Int
6 Int
21 )
  , ( Text
"National Flag of Canada Day", String
"national flag of canada day", Int -> Int -> TimeData
monthDay Int
2 Int
15 )
  , ( Text
"National Tartan Day", String
"national tartan day", Int -> Int -> TimeData
monthDay Int
4 Int
6 )
  , ( Text
"Nunavut Day", String
"nunavut day", Int -> Int -> TimeData
monthDay Int
7 Int
9 )
  , ( Text
"Remembrance Day", String
"remembrance day", Int -> Int -> TimeData
monthDay Int
11 Int
11 )
  , ( Text
"St David's Day", String
"st\\.? david'?s day", Int -> Int -> TimeData
monthDay Int
3 Int
1 )
  , ( Text
"St. Jean Baptiste Day", String
"st\\.? jean baptiste day", Int -> Int -> TimeData
monthDay Int
6 Int
24 )
  , ( Text
"The Twelfth", String
"orangemen's day|the (glorious )?twelfth", Int -> Int -> TimeData
monthDay Int
7 Int
12 )
  , ( Text
"Victoria Day", String
"sovereign's birthday|victoria day"
    , TimeData -> TimeData -> TimeData
predLastOf (Int -> TimeData
dayOfWeek Int
1) (Int -> Int -> TimeData
monthDay Int
5 Int
25) )
  , ( Text
"Vimy Ridge Day", String
"vimy ridge day", Int -> Int -> TimeData
monthDay Int
4 Int
9 )

  -- Fixed day/week/month, year over year
  , ( Text
"Civic Holiday"
    , String
"british columbia day|civic holiday|natal day|new brunswick day|Saskatchewan Day|terry fox day"
    , Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
1 Int
8
    )
  , ( Text
"Family Day"
    , String
"(family|islander|louis riel|nova scotia heritage) day"
    , Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
3 Int
1 Int
2 )
  , ( Text
"Father's Day", String
"father'?s?'? day", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
3 Int
7 Int
6 )
  , ( Text
"Gold Cup Parade", String
"gold cup parade", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
3 Int
5 Int
8 )
  , ( Text
"Heritage Day in Alberta", String
"heritage day in alberta", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
1 Int
8 )
  , ( Text
"Labour Day", String
"labou?r day", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
1 Int
9 )
  -- Long weekend before the first Monday of September
  , ( Text
"Labour Day weekend", String
"labou?r day week(\\s|-)?ends?"
    , TimeData -> TimeData
longWEBefore (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
1 Int
9
    )
  , ( Text
"Mother's Day", String
"mother'?s?'? day", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
2 Int
7 Int
5 )
  , ( Text
"Royal St. John's Regatta", String
"regatta day|royal st\\.? john's regatta"
    , Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
3 Int
8 )
  , ( Text
"Take our Daughters and Sons to Work Day"
    , String
"take our daughters and sons to work day", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
1 Int
3 Int
11 )
  , ( Text
"Thanksgiving Day", String
"thanks?giving( day)?", Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
2 Int
1 Int
10 )
  , ( Text
"Yukon's Discovery Day", String
"(klondike gold|yukon's) discovery day"
    , Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
3 Int
1 Int
8 )

  -- Monday before May 25th
  , ( Text
"National Patriots' Day", String
"national patriot'?s'? day"
    , Int -> TimeData -> TimeData -> TimeData
predNthAfter (-Int
1) (Int -> TimeData
dayOfWeek Int
1) (Int -> Int -> TimeData
monthDay Int
5 Int
25) )

  -- Closest Monday to June 24th
  , ( Text
"Discovery Day", String
"discovery\\s+day"
    , Int -> TimeData -> TimeData -> TimeData
predNthClosest Int
0 (Int -> TimeData
dayOfWeek Int
1) (Int -> Int -> TimeData
monthDay Int
6 Int
24) )

  -- Wednesday of the last full week of April, where a full week starts on
  -- Sunday and ends on Saturday.
  , ( Text
"Administrative Professionals' Day"
    , String
"(administrative professional|secretarie|admin)('?s'?)? day"
    , Bool -> Grain -> Int -> TimeData -> TimeData
cycleNthAfter Bool
False Grain
TG.Day (-Int
3) (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$
        Int -> TimeData -> TimeData -> TimeData
predNthAfter (-Int
1) (Int -> TimeData
dayOfWeek Int
6) (Int -> Int -> TimeData
monthDay Int
5 Int
1)
    )
  ]

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleMMDD
  , Rule
ruleMMDDYYYY
  , Rule
ruleMMDDYYYYDot
  ]
  [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ [Rule]
rulePeriodicHolidays