-- 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 OverloadedStrings #-}

module Duckling.PhoneNumber.AR.Corpus
  ( corpus
  , negativeCorpus
  ) where

import Prelude
import Data.String

import Duckling.Locale
import Duckling.PhoneNumber.Types
import Duckling.Resolve
import Duckling.Testing.Types

corpus :: Corpus
corpus :: Corpus
corpus =
  (Context
testContext { locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
AR Maybe Region
forall a. Maybe a
Nothing }, Options
testOptions, [Example]
allExamples)

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
testContext, Options
testOptions, [Text]
xs)
  where
    xs :: [Text]
xs =
      [ Text
"١٢٣٤٥"
      , Text
"١٢٣٤٥٦٧٨٩٠١٢٣٤٥٦٧٧٧٧٧٧"
      , Text
"١٢٣٤٥٦٧٨٩٠١٢٣٤٥٦"
      ]

-- Tests include both unicode characters and equivalent unicode decimal code
-- representation because the Arabic phone number regex is constructed with
-- unicode decimal form.
allExamples :: [Example]
allExamples :: [Example]
allExamples =
  [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"6507018887")
               [ Text
"٦٥٠٧٠١٨٨٨٧"
               , Text
"\1638\1637\1632\1639\1632\1633\1640\1640\1640\1639"
               , Text
"٦٥٠ ٧٠١ ٨٨٨٧"
               , Text
"\1638\1637\1632 \1639\1632\1633 \1640\1640\1640\1639"
               , Text
"٦٥٠-٧٠١-٨٨٨٧"
               , Text
"\1638\1637\1632-\1639\1632\1633-\1640\1640\1640\1639"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"(+1) 6507018887")
               [ Text
"+١ ٦٥٠٧٠١٨٨٨٧"
               , Text
"+\1633 \1638\1637\1632\1639\1632\1633\1640\1640\1640\1639"
               , Text
"(+١)٦٥٠٧٠١٨٨٨٧"
               , Text
"(+\1633)\1638\1637\1632\1639\1632\1633\1640\1640\1640\1639"
               , Text
"(+١)   ٦٥٠ - ٧٠١  ٨٨٨٧"
               , Text
"(+\1633)    \1638\1637\1632 - \1639\1632\1633  \1640\1640\1640\1639"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"(+33) 146647998")
               [ Text
"+٣٣ ١ ٤٦٦٤٧٩٩٨"
               , Text
"+\1635\1635 \1633 \1636\1638\1638\1636\1639\1641\1641\1640"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"0620702220")
               [ Text
"٠٦ ٢٠٧٠ ٢٢٢٠"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"6507018887 ext 897")
               [ Text
"٦٥٠٧٠١٨٨٨٧ ext ٨٩٧"
               , Text
"٦٥٠٧٠١٨٨٨٧ x ٨٩٧"
               , Text
"٦٥٠٧٠١٨٨٨٧ ext. ٨٩٧"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"6507018887 ext 897")
               [ Text
"٦٥٠٧٠١٨٨٨٧ فرعي ٨٩٧"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"(+1) 2025550121")
               [ Text
"+١-٢٠٢-٥٥٥-٠١٢١"
               , Text
"+١ ٢٠٢.٥٥٥.٠١٢١"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"4866827")
               [ Text
"٤.٨.٦.٦.٨.٢.٧"
               ]
    , PhoneNumberValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> PhoneNumberValue
PhoneNumberValue Text
"(+55) 19992842606")
               [ Text
"(+٥٥) ١٩٩٩٢٨٤٢٦٠٦"
               ]
    ]