content: -- 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
    { name = "mm/dd"
    , pattern =
      [ regex "(1[0-2]|0?[1-9])\\s?[/-]\\s?(3[01]|[12]\\d|0?[1-9])"
      ]
    , prod = \tokens -> case tokens of
        (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do
          m <- parseInt mm
          d <- parseInt dd
          tt $ monthDay m d
        _ -> Nothing
    }
  
  ruleMMDDYYYY :: Rule
  ruleMMDDYYYY = Rule
    { name = "mm/dd/yyyy"
    , pattern =
      [ regex "(1[0-2]|0?[1-9])[-/\\s](3[01]|[12]\\d|0?[1-9])[-/\\s](\\d{2,4})"
      ]
    , prod = \tokens -> case tokens of
        (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do
          y <- parseInt yy
          m <- parseInt mm
          d <- parseInt dd
          tt $ yearMonthDay y m d
        _ -> Nothing
    }
  
  -- Clashes with HHMMSS, hence only 4-digit years
  ruleMMDDYYYYDot :: Rule
  ruleMMDDYYYYDot = Rule
    { name = "mm.dd.yyyy"
    , pattern =
      [ regex "(1[0-2]|0?[1-9])\\.(3[01]|[12]\\d|0?[1-9])\\.(\\d{4})"
      ]
    , prod = \tokens -> case tokens of
        (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do
          y <- parseInt yy
          m <- parseInt mm
          d <- parseInt dd
          tt $ yearMonthDay y m d
        _ -> Nothing
    }
  
  rulePeriodicHolidays :: [Rule]
  rulePeriodicHolidays = mkRuleHolidays
    -- Fixed dates, year over year
    [ ( "Anniversary of the Statute of Westminster", "anniversary of the statute of westminster", monthDay 12 11 )
    , ( "Memorial Day", "(canada|dominion|memorial) day", monthDay 7 1 )
    , ( "Groundhog Day", "groundhogs? day", monthDay 2 2 )
    , ( "Healthcare Aide Day", "healthcare aide day", monthDay 10 18 )
    , ( "National Aboriginal Day", "national aboriginal day", monthDay 6 21 )
    , ( "National Flag of Canada Day", "national flag of canada day", monthDay 2 15 )
    , ( "National Tartan Day", "national tartan day", monthDay 4 6 )
    , ( "Nunavut Day", "nunavut day", monthDay 7 9 )
    , ( "Remembrance Day", "remembrance day", monthDay 11 11 )
    , ( "St David's Day", "st\\.? david'?s day", monthDay 3 1 )
    , ( "St. Jean Baptiste Day", "st\\.? jean baptiste day", monthDay 6 24 )
    , ( "The Twelfth", "orangemen's day|the (glorious )?twelfth", monthDay 7 12 )
    , ( "Victoria Day", "sovereign's birthday|victoria day"
      , predLastOf (dayOfWeek 1) (monthDay 5 25) )
    , ( "Vimy Ridge Day", "vimy ridge day", monthDay 4 9 )
  
    -- Fixed day/week/month, year over year
    , ( "Civic Holiday"
      , "british columbia day|civic holiday|natal day|new brunswick day|Saskatchewan Day|terry fox day"
      , nthDOWOfMonth 1 1 8
      )
    , ( "Family Day"
      , "(family|islander|louis riel|nova scotia heritage) day"
      , nthDOWOfMonth 3 1 2 )
    , ( "Father's Day", "father'?s?'? day", nthDOWOfMonth 3 7 6 )
    , ( "Gold Cup Parade", "gold cup parade", nthDOWOfMonth 3 5 8 )
    , ( "Heritage Day in Alberta", "heritage day in alberta", nthDOWOfMonth 1 1 8 )
    , ( "Labour Day", "labou?r day", nthDOWOfMonth 1 1 9 )
    -- Long weekend before the first Monday of September
    , ( "Labour Day weekend", "labou?r day week(\\s|-)?ends?"
      , longWEBefore $ nthDOWOfMonth 1 1 9
      )
    , ( "Mother's Day", "mother'?s?'? day", nthDOWOfMonth 2 7 5 )
    , ( "Royal St. John's Regatta", "regatta day|royal st\\.? john's regatta"
      , nthDOWOfMonth 1 3 8 )
    , ( "Take our Daughters and Sons to Work Day"
      , "take our daughters and sons to work day", nthDOWOfMonth 1 3 11 )
    , ( "Thanksgiving Day", "thanks?giving( day)?", nthDOWOfMonth 2 1 10 )
    , ( "Yukon's Discovery Day", "(klondike gold|yukon's) discovery day"
      , nthDOWOfMonth 3 1 8 )
  
    -- Monday before May 25th
    , ( "National Patriots' Day", "national patriot'?s'? day"
      , predNthAfter (-1) (dayOfWeek 1) (monthDay 5 25) )
  
    -- Closest Monday to June 24th
    , ( "Discovery Day", "discovery\\s+day"
      , predNthClosest 0 (dayOfWeek 1) (monthDay 6 24) )
  
    -- Wednesday of the last full week of April, where a full week starts on
    -- Sunday and ends on Saturday.
    , ( "Administrative Professionals' Day"
      , "(administrative professional|secretarie|admin)('?s'?)? day"
      , cycleNthAfter False TG.Day (-3) $
          predNthAfter (-1) (dayOfWeek 6) (monthDay 5 1)
      )
    ]
  
  rules :: [Rule]
  rules =
    [ ruleMMDD
    , ruleMMDDYYYY
    , ruleMMDDYYYYDot
    ]
    ++ rulePeriodicHolidays
  