-- 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 NoRebindableSyntax #-}
{-# LANGUAGE RecordWildCards #-}

module Duckling.Api
  ( analyze
  , formatToken
  , parse
  , supportedDimensions
  ) where

import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Text (Text)
import Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text

import Duckling.Dimensions.Types
import Duckling.Dimensions
import Duckling.Engine
import Duckling.Locale
import Duckling.Ranking.Classifiers
import Duckling.Ranking.Rank
import Duckling.Resolve
import Duckling.Rules
import Duckling.Types

-- | Parses `input` and returns a curated list of entities found.
parse
  :: Text
  -> Context
  -> Options
  -> [Seal Dimension]
  -> [Entity]
parse input ctx options =
  map (formatToken input)
  . analyze input ctx options
  . HashSet.fromList

supportedDimensions :: HashMap Lang [Seal Dimension]
supportedDimensions =
  HashMap.fromList [ (l, allDimensions l) | l <- [minBound..maxBound] ]

-- | Returns a curated list of resolved tokens found
-- When `targets` is non-empty, returns only tokens of such dimensions.
analyze
  :: Text
  -> Context
  -> Options
  -> HashSet (Seal Dimension)
  -> [ResolvedToken]
analyze input context@Context{..} options targets =
  rank (classifiers locale) targets
  $ filter isRelevantDimension
  $ parseAndResolve (rulesFor locale targets) input context options
  where
    isRelevantDimension Resolved{node = Node{token = (Token d _)}} =
      HashSet.null targets || HashSet.member (Seal d) targets

-- | Converts the resolved token to the API format
formatToken :: Text -> ResolvedToken -> Entity
formatToken sentence
  (Resolved (Range start end) node@Node{token = Token dim _} value latent)
  = Entity (toName dim) body value start end latent node
  where
    body = Text.drop start $ Text.take end sentence


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

-- | Everything needed to run Duckling.

module Duckling.Core
  ( Context(..)
  , Dimension(..)
  , Entity(..)
  , Lang(..)
  , Locale
  , Node(..)
  , Options(..)
  , Range(..)
  , Region(..)
  , ResolvedVal(..)
  , Seal(..)
  , withSeal
  , fromName
  , makeLocale
  , toJText
  , toName

  -- Duckling API
  , parse
  , supportedDimensions
  , allLocales

  -- Reference time builders
  , currentReftime
  , fromZonedTime
  , makeReftime
  ) where

import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Data.Time
import Data.Time.LocalTime.TimeZone.Series
import Prelude
import qualified Data.HashMap.Strict as HashMap

import Duckling.Api
import Duckling.Dimensions.Types
import Duckling.Locale
import Duckling.Resolve
import Duckling.Types

-- | Builds a `DucklingTime` for timezone `tz` at `utcTime`.
-- If no `series` found for `tz`, uses UTC.
makeReftime :: HashMap Text TimeZoneSeries -> Text -> UTCTime -> DucklingTime
makeReftime series tz utcTime = DucklingTime $ ZoneSeriesTime ducklingTime tzs
  where
    tzs = HashMap.lookupDefault (TimeZoneSeries utc []) tz series
    ducklingTime = toUTC $ utcToLocalTime' tzs utcTime

-- | Builds a `DucklingTime` for timezone `tz` at current time.
-- If no `series` found for `tz`, uses UTC.
currentReftime :: HashMap Text TimeZoneSeries -> Text -> IO DucklingTime
currentReftime series tz = makeReftime series tz <$> getCurrentTime

-- | Builds a `DucklingTime` from a `ZonedTime`.
fromZonedTime :: ZonedTime -> DucklingTime
fromZonedTime (ZonedTime localTime timeZone) = DucklingTime $
  ZoneSeriesTime (toUTC localTime) (TimeZoneSeries timeZone [])


-- 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 NamedFieldPuns #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Debug
  ( allParses
  , debug
  , debugCustom
  , fullParses
  , ptree
  ) where

import Data.Maybe
import Data.Text (Text)
import Prelude
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import Duckling.Api
import Duckling.Dimensions.Types
import Duckling.Engine
import Duckling.Locale
import Duckling.Resolve
import Duckling.Rules
import Duckling.Testing.Types
import Duckling.Types

-- -----------------------------------------------------------------
-- API

debug :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
debug locale = debugCustom testContext {locale = locale} testOptions

allParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
allParses l input targets = debugTokens input $ parses l input targets

fullParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
fullParses l input targets =
  debugTokens
    input
    $ filter
      (\Resolved{range = Range start end} -> start == 0 && end == n)
      $ parses l input targets
  where
    n = Text.length input

debugCustom :: Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]
debugCustom context options input targets =
  debugTokens
    input
    $ analyze input context options $ HashSet.fromList targets

ptree :: Text -> Entity -> IO ()
ptree input Entity {enode} = pnode input 0 enode

-- -----------------------------------------------------------------
-- Internals

parses :: Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses l input targets =
  filter isRelevantDimension tokens
  where
    tokens = parseAndResolve rules input testContext {locale = l} testOptions
    rules = rulesFor l $ HashSet.fromList targets
    isRelevantDimension Resolved{node = Node{token = (Token d _)}} =
      case targets of
        [] -> True
        _ -> elem (Seal d) targets

debugTokens :: Text -> [ResolvedToken] -> IO [Entity]
debugTokens input tokens = do
  mapM_ (ptree input) entities
  return entities
  where entities = map (formatToken input) tokens

pnode :: Text -> Int -> Node -> IO ()
pnode input depth Node {children, rule, nodeRange = Range start end} = do
  Text.putStrLn out
  mapM_ (pnode input (depth + 1)) children
  where
    out = Text.concat [ Text.replicate depth "-- ", name, " (", body, ")" ]
    name = fromMaybe "regex" rule
    body = Text.drop start $ Text.take end input


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

module Duckling.Dimensions
  ( allDimensions
  , explicitDimensions
  ) where

import Data.HashSet (HashSet)
import Prelude
import qualified Data.HashSet as HashSet

import Duckling.Dimensions.Types
import Duckling.Locale
import Duckling.Types
import qualified Duckling.Dimensions.Common as CommonDimensions
import qualified Duckling.Dimensions.AF as AFDimensions
import qualified Duckling.Dimensions.AR as ARDimensions
import qualified Duckling.Dimensions.BG as BGDimensions
import qualified Duckling.Dimensions.BN as BNDimensions
import qualified Duckling.Dimensions.CA as CADimensions
import qualified Duckling.Dimensions.CS as CSDimensions
import qualified Duckling.Dimensions.DA as DADimensions
import qualified Duckling.Dimensions.DE as DEDimensions
import qualified Duckling.Dimensions.EL as ELDimensions
import qualified Duckling.Dimensions.EN as ENDimensions
import qualified Duckling.Dimensions.ES as ESDimensions
import qualified Duckling.Dimensions.ET as ETDimensions
import qualified Duckling.Dimensions.FA as FADimensions
import qualified Duckling.Dimensions.FI as FIDimensions
import qualified Duckling.Dimensions.FR as FRDimensions
import qualified Duckling.Dimensions.GA as GADimensions
import qualified Duckling.Dimensions.HE as HEDimensions
import qualified Duckling.Dimensions.HI as HIDimensions
import qualified Duckling.Dimensions.HR as HRDimensions
import qualified Duckling.Dimensions.HU as HUDimensions
import qualified Duckling.Dimensions.ID as IDDimensions
import qualified Duckling.Dimensions.IS as ISDimensions
import qualified Duckling.Dimensions.IT as ITDimensions
import qualified Duckling.Dimensions.JA as JADimensions
import qualified Duckling.Dimensions.KA as KADimensions
import qualified Duckling.Dimensions.KM as KMDimensions
import qualified Duckling.Dimensions.KN as KNDimensions
import qualified Duckling.Dimensions.KO as KODimensions
import qualified Duckling.Dimensions.LO as LODimensions
import qualified Duckling.Dimensions.ML as MLDimensions
import qualified Duckling.Dimensions.MN as MNDimensions
import qualified Duckling.Dimensions.MY as MYDimensions
import qualified Duckling.Dimensions.NB as NBDimensions
import qualified Duckling.Dimensions.NE as NEDimensions
import qualified Duckling.Dimensions.NL as NLDimensions
import qualified Duckling.Dimensions.PL as PLDimensions
import qualified Duckling.Dimensions.PT as PTDimensions
import qualified Duckling.Dimensions.RO as RODimensions
import qualified Duckling.Dimensions.RU as RUDimensions
import qualified Duckling.Dimensions.SK as SKDimensions
import qualified Duckling.Dimensions.SV as SVDimensions
import qualified Duckling.Dimensions.SW as SWDimensions
import qualified Duckling.Dimensions.TA as TADimensions
import qualified Duckling.Dimensions.TE as TEDimensions
import qualified Duckling.Dimensions.TH as THDimensions
import qualified Duckling.Dimensions.TR as TRDimensions
import qualified Duckling.Dimensions.UK as UKDimensions
import qualified Duckling.Dimensions.VI as VIDimensions
import qualified Duckling.Dimensions.ZH as ZHDimensions

allDimensions :: Lang -> [Seal Dimension]
allDimensions lang = CommonDimensions.allDimensions ++ langDimensions lang

-- | Augments `targets` with all dependent dimensions.
explicitDimensions :: HashSet (Seal Dimension) -> HashSet (Seal Dimension)
explicitDimensions targets = HashSet.union targets deps
  where
    deps = HashSet.unions . map dependents $ HashSet.toList targets

-- | Ordinal depends on Numeral for JA, KO, and ZH.
dependents :: Seal Dimension -> HashSet (Seal Dimension)
dependents (Seal CreditCardNumber) = HashSet.empty
dependents (Seal Distance) = HashSet.singleton (Seal Numeral)
dependents (Seal Duration) = HashSet.fromList [Seal Numeral, Seal TimeGrain]
dependents (Seal Numeral) = HashSet.empty
dependents (Seal Email) = HashSet.empty
dependents (Seal AmountOfMoney) = HashSet.singleton (Seal Numeral)
dependents (Seal Ordinal) = HashSet.singleton (Seal Numeral)
dependents (Seal PhoneNumber) = HashSet.empty
dependents (Seal Quantity) = HashSet.singleton (Seal Numeral)
dependents (Seal RegexMatch) = HashSet.empty
dependents (Seal Temperature) = HashSet.singleton (Seal Numeral)
dependents (Seal Time) =
  HashSet.fromList [Seal Numeral, Seal Duration, Seal Ordinal, Seal TimeGrain]
dependents (Seal TimeGrain) = HashSet.empty
dependents (Seal Url) = HashSet.empty
dependents (Seal Volume) = HashSet.singleton (Seal Numeral)
dependents (Seal (CustomDimension dim)) = dimDependents dim

langDimensions :: Lang -> [Seal Dimension]
langDimensions AF = AFDimensions.allDimensions
langDimensions AR = ARDimensions.allDimensions
langDimensions BG = BGDimensions.allDimensions
langDimensions BN = BNDimensions.allDimensions
langDimensions CA = CADimensions.allDimensions
langDimensions CS = CSDimensions.allDimensions
langDimensions DA = DADimensions.allDimensions
langDimensions DE = DEDimensions.allDimensions
langDimensions EL = ELDimensions.allDimensions
langDimensions EN = ENDimensions.allDimensions
langDimensions ES = ESDimensions.allDimensions
langDimensions ET = ETDimensions.allDimensions
langDimensions FA = FADimensions.allDimensions
langDimensions FI = FIDimensions.allDimensions
langDimensions FR = FRDimensions.allDimensions
langDimensions GA = GADimensions.allDimensions
langDimensions HE = HEDimensions.allDimensions
langDimensions HI = HIDimensions.allDimensions
langDimensions HR = HRDimensions.allDimensions
langDimensions HU = HUDimensions.allDimensions
langDimensions ID = IDDimensions.allDimensions
langDimensions IS = ISDimensions.allDimensions
langDimensions IT = ITDimensions.allDimensions
langDimensions JA = JADimensions.allDimensions
langDimensions KA = KADimensions.allDimensions
langDimensions KM = KMDimensions.allDimensions
langDimensions KN = KNDimensions.allDimensions
langDimensions KO = KODimensions.allDimensions
langDimensions LO = LODimensions.allDimensions
langDimensions ML = MLDimensions.allDimensions
langDimensions MN = MNDimensions.allDimensions
langDimensions MY = MYDimensions.allDimensions
langDimensions NB = NBDimensions.allDimensions
langDimensions NE = NEDimensions.allDimensions
langDimensions NL = NLDimensions.allDimensions
langDimensions PL = PLDimensions.allDimensions
langDimensions PT = PTDimensions.allDimensions
langDimensions RO = RODimensions.allDimensions
langDimensions RU = RUDimensions.allDimensions
langDimensions SK = SKDimensions.allDimensions
langDimensions SV = SVDimensions.allDimensions
langDimensions SW = SWDimensions.allDimensions
langDimensions TA = TADimensions.allDimensions
langDimensions TE = TEDimensions.allDimensions
langDimensions TH = THDimensions.allDimensions
langDimensions TR = TRDimensions.allDimensions
langDimensions UK = UKDimensions.allDimensions
langDimensions VI = VIDimensions.allDimensions
langDimensions ZH = ZHDimensions.allDimensions


-- 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 NamedFieldPuns #-}
{-# LANGUAGE NoRebindableSyntax #-}

module Duckling.Engine
  ( parseAndResolve
  , lookupRegexAnywhere
  , runDuckling
  ) where

import Control.DeepSeq
import Control.Monad.Extra
import Data.ByteString (ByteString)
import Data.Functor.Identity
import Data.Maybe
import Data.Text (Text)
import Prelude
import qualified Data.Array as Array
import qualified Data.Foldable as Foldable
import qualified Data.List as L
import qualified Text.Regex.PCRE as PCRE

import Duckling.Dimensions.Types
import Duckling.Locale
import Duckling.Regex.Types
import Duckling.Resolve
import Duckling.Types hiding (regex)
import Duckling.Types.Document (Document)
import Duckling.Types.Stash (Stash)
import qualified Duckling.Engine.Regex as Regex
import qualified Duckling.Types.Document as Document
import qualified Duckling.Types.Stash as Stash

-- -----------------------------------------------------------------
-- Engine

parseAndResolve :: [Rule] -> Text -> Context -> Options -> [ResolvedToken]
parseAndResolve rules input context@Context{locale = Locale lang _} options =
  mapMaybe
    (resolveNode context options)
    $ force $ Stash.toPosOrderedList
      $ runDuckling $ parseString lang rules (Document.fromText input)

type Duckling a = Identity a

runDuckling :: Duckling a -> a
runDuckling ma = runIdentity ma

-- | A match is full if its rule pattern is empty.
-- (rule, endPosition, reversedRoute)
type Match = (Rule, Int, [Node])

resolveNode :: Context -> Options -> Node -> Maybe ResolvedToken
resolveNode context options n@Node{token = (Token dim dd), nodeRange = r}
  = do
  (val, latent) <- resolve context options dd
  Just Resolved
    { range = r
    , node = n
    , rval = RVal dim val
    , isLatent = latent
    }

parseString :: Lang -> [Rule] -> Document -> Duckling Stash
parseString lang rules sentence = do
  (new, partialMatches) <-
    -- One the first pass we try all the rules
    parseString1 lang rules sentence Stash.empty Stash.empty []
  if Stash.null new
    then return Stash.empty
    else
    -- For subsequent passes, we only try rules starting with a predicate.
    saturateParseString lang headPredicateRules sentence new new partialMatches
  where
  headPredicateRules =
    [ rule | rule@Rule{pattern = (Predicate _ : _)} <- rules ]

-- | Produces all tokens recursively.
saturateParseString
  :: Lang -> [Rule] -> Document -> Stash -> Stash -> [Match] -> Duckling Stash
saturateParseString lang rules sentence stash new matches = do
  (new', matches') <- parseString1 lang rules sentence stash new matches
  let stash' = Stash.union stash new'
  if Stash.null new'
    then return stash
    else saturateParseString lang rules sentence stash' new' matches'

-- | Finds new matches resulting from newly added tokens.
-- Produces new tokens from full matches.
parseString1
  :: Lang -> [Rule] -> Document -> Stash -> Stash -> [Match]
  -> Duckling (Stash, [Match])
parseString1 lang rules sentence stash new matches = do
  -- Recursively match patterns.
  -- Find which `matches` can advance because of `new`.
  newPartial <- concatMapM (matchFirst sentence lang new) matches

  -- Find new matches resulting from newly added tokens (`new`)
  newMatches <- concatMapM (matchFirstAnywhere sentence lang new) rules

  (full, partial) <- L.partition (\(Rule {pattern}, _, _) -> null pattern)
    <$> matchAll sentence lang stash (newPartial ++ newMatches)

  -- Produce full matches as new tokens
  return ( Stash.fromList $ mapMaybe produce full
         , partial ++ matches
         )

-- | Recursively augments `matches`.
-- Discards partial matches stuck by a regex.
matchAll :: Document -> Lang -> Stash -> [Match] -> Duckling [Match]
matchAll sentence lang stash matches = concatMapM mkNextMatches matches
  where
    mkNextMatches :: Match -> Duckling [Match]
    mkNextMatches match@(Rule {pattern = []}, _, _) = return [ match ]
    mkNextMatches match@(Rule {pattern = p:_}, _, _) = do
      nextMatches <- matchAll sentence lang stash =<< matchFirst sentence lang stash match
      return $ case p of
        Regex _ -> nextMatches
        Predicate _ -> match:nextMatches

produce :: Match -> Maybe Node
produce (_, _, []) = Nothing
produce (Rule name _ production, _, etuor@(Node {nodeRange = Range _ e}:_)) = do
  let route = reverse etuor
  token <- force $ production $ map token route
  case route of
    (Node {nodeRange = Range p _}:_) -> Just Node
      { nodeRange = Range p e
      , token = token
      , children = route
      , rule = Just name
      }
    [] -> Nothing

-- | Returns all matches matching the first pattern item of `match`,
-- resuming from a Match position
matchFirst :: Document -> Lang -> Stash -> Match -> Duckling [Match]
matchFirst _ _ _ (Rule {pattern = []}, _, _) = return []
matchFirst sentence lang stash (rule@Rule{pattern = p : ps}, position, route) =
  map (mkMatch route newRule) <$> lookupItem sentence lang p stash position
  where
  newRule = rule { pattern = ps }

-- | Returns all matches matching the first pattern item of `match`,
-- starting anywhere
matchFirstAnywhere :: Document -> Lang -> Stash -> Rule -> Duckling [Match]
matchFirstAnywhere _sentence _lang _stash Rule {pattern = []} = return []
matchFirstAnywhere sentence lang stash rule@Rule{pattern = p : ps} =
  map (mkMatch [] newRule) <$> lookupItemAnywhere sentence lang p stash
  where
  newRule = rule { pattern = ps }

-- | Handle one PatternItem at a given position
lookupItem :: Document -> Lang -> PatternItem -> Stash -> Int -> Duckling [Node]
lookupItem doc lang (Regex re) _ position =
  filter (isPositionValid position doc) <$>
  lookupRegex doc lang re position
lookupItem doc _lang (Predicate p) stash position =
  return $
  filter (p . token) $
  takeWhile (isPositionValid position doc) $
  Stash.toPosOrderedListFrom stash position

-- | Handle one PatternItem anywhere in the text
lookupItemAnywhere :: Document -> Lang -> PatternItem -> Stash -> Duckling [Node]
lookupItemAnywhere doc lang (Regex re) _ = lookupRegexAnywhere doc lang re
lookupItemAnywhere _doc _lang (Predicate p) stash =
  return $ filter (p . token) $ Stash.toPosOrderedList stash

isPositionValid :: Int -> Document -> Node -> Bool
isPositionValid position sentence Node{nodeRange = Range start _} =
  Document.isAdjacent sentence position start

{-# INLINE mkMatch #-}
mkMatch :: [Node] -> Rule -> Node -> Match
mkMatch route newRule node@Node{nodeRange = Range _ pos'} =
  newRoute `seq` (newRule, pos', newRoute)
  where newRoute = node:route

-- | Handle a regex match at a given position
lookupRegex :: Document -> Lang -> PCRE.Regex -> Int -> Duckling [Node]
lookupRegex doc _lang _regex position | position >= Document.length doc = return []
lookupRegex doc lang regex position =
  lookupRegexCommon doc lang regex position Regex.matchOnce

-- | Handle a regex match anywhere in the text
lookupRegexAnywhere :: Document -> Lang -> PCRE.Regex -> Duckling [Node]
lookupRegexAnywhere doc lang regex = lookupRegexCommon doc lang regex 0 Regex.matchAll

{-# INLINE lookupRegexCommon #-}
-- INLINE bloats the code a bit, but the code is better
lookupRegexCommon
  :: Foldable t
  => Document
  -> Lang
  -> PCRE.Regex
  -> Int
  -> (PCRE.Regex -> ByteString -> t PCRE.MatchArray)
  -> Duckling [Node]
lookupRegexCommon doc lang regex position matchFun = return nodes
  where
  -- See Note [Regular expressions and Text] from Document.hs to understand
  -- what's going on here
  (substring, rangeToText, translateRange) =
    Document.byteStringFromPos doc position
  nodes = mapMaybe (f . Array.elems)
    $ Foldable.toList
    $ matchFun regex substring
  f :: [(Int, Int)] -> Maybe Node
  f [] = Nothing
  f ((0,0):_) = Nothing
  f ((bsStart, bsLen):groups) =
    if Document.isRangeValid lang doc start end
      then Just node
      else Nothing
    where
    textGroups = map rangeToText groups
    (start, end) = translateRange bsStart bsLen
    node = Node
      { nodeRange = Range start end
      , token = Token RegexMatch (GroupMatch textGroups)
      , children = []
      , rule = Nothing
      }


-- 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 DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoRebindableSyntax #-}
module Duckling.Locale
  ( Lang(..)
  , Locale(..)
  , Region
      ( AU
      , BE
      , BZ
      , CL
      , CN
      , CO
      , EG
      , GB
      , HK
      , IE
      , IN
      , JM
      , MO
      , MX
      , NZ
      , PE
      , PH
      , TT
      , TW
      , US
      , VE
      , ZA
      )
  , allLocales
  , makeLocale
  ) where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Hashable
import GHC.Generics
import Prelude
import TextShow (TextShow)
import qualified TextShow as TS

import Duckling.Region hiding
  ( AR
  , CA
  , ES
  , NL
  )
import qualified Duckling.Region as R
  ( Region
      ( AR
      , CA
      , ES
      , NL
      )
  )

-- | ISO 639-1 Language.
-- See https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes
data Lang
  = AF
  | AR
  | BG
  | BN
  | CA
  | CS
  | DA
  | DE
  | EL
  | EN
  | ES
  | ET
  | FA
  | FI
  | FR
  | GA
  | HE
  | HI
  | HR
  | HU
  | ID
  | IS
  | IT
  | JA
  | KA
  | KN
  | KM
  | KO
  | LO
  | ML
  | MN
  | MY
  | NB
  | NE
  | NL
  | PL
  | PT
  | RO
  | RU
  | SK
  | SV
  | SW
  | TA
  | TE
  | TH
  | TR
  | UK
  | VI
  | ZH
  deriving (Bounded, Enum, Eq, Generic, Hashable, Ord, Read, Show)

instance TextShow Lang where
  showb = TS.fromString . show

data Locale = Locale Lang (Maybe Region)
  deriving (Eq, Generic, Hashable, Ord)

instance Show Locale where
  show (Locale lang Nothing) = show lang ++ "_XX"
  show (Locale lang (Just region)) = show lang ++ "_" ++ show region

instance TextShow Locale where
  showb = TS.fromString . show

makeLocale :: Lang -> Maybe Region -> Locale
makeLocale lang Nothing = Locale lang Nothing
makeLocale lang (Just region)
  | HashSet.member region locales = Locale lang $ Just region
  | otherwise = Locale lang Nothing
  where
    locales = HashMap.lookupDefault HashSet.empty lang allLocales

allLocales :: HashMap Lang (HashSet Region)
allLocales =
  HashMap.fromList
    [ (AR, HashSet.fromList [EG])
    , (EN, HashSet.fromList [AU, BZ, R.CA, GB, IN, IE, JM, NZ, PH, ZA, TT, US])
    , (ES, HashSet.fromList [R.AR, CL, CO, R.ES, MX, PE, VE])
    , (NL, HashSet.fromList [BE, R.NL])
    , (ZH, HashSet.fromList [CN, HK, MO, TW])
    ]


-- 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 DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoRebindableSyntax #-}

module Duckling.Region
  ( Region(..)
  ) where

import Data.Hashable
import GHC.Generics
import Prelude
import TextShow (TextShow)
import qualified TextShow as TS

-- | ISO 3166-1 alpha-2 Country code (includes regions and territories).
-- See https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2
data Region
  = AR
  | AU
  | BE
  | BZ
  | CA
  | CL
  | CN
  | CO
  | EG
  | ES
  | GB
  | HK
  | IE
  | IN
  | JM
  | MN
  | MX
  | MO
  | NL
  | NZ
  | PE
  | PH
  | TT
  | TW
  | US
  | VE
  | ZA
  deriving (Bounded, Enum, Eq, Generic, Hashable, Ord, Read, Show)

instance TextShow Region where
  showb = TS.fromString . show


-- 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 FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

module Duckling.Resolve
  ( Context(..)
  , DucklingTime(..)
  , Options(..)
  , Resolve(..)
  , fromUTC
  , toUTC
  ) where

import Data.Aeson (ToJSON)
import Prelude
import qualified Data.Time as Time
import qualified Data.Time.LocalTime.TimeZone.Series as Series

import Duckling.Locale

-- | Internal time reference.
-- We work as if we were in UTC time and use `ZoneSeriesTime` to house the info.
-- We convert to local time at resolution, using `fromUTC`.
newtype DucklingTime = DucklingTime Series.ZoneSeriesTime
  deriving (Eq, Show)

data Context = Context
  { referenceTime :: DucklingTime
  , locale :: Locale
  }
  deriving (Eq, Show)

newtype Options = Options
  { withLatent :: Bool  -- When set, includes less certain parses, e.g. "7" as an hour of the day
  }
  deriving (Eq, Show)

class ( Eq (ResolvedValue a)
      , Show (ResolvedValue a)
      , ToJSON (ResolvedValue a)
      ) => Resolve a where
  type ResolvedValue a
  resolve :: Context -> Options -> a -> Maybe (ResolvedValue a, Bool)

-- | Given a UTCTime and an TimeZone, build a ZonedTime (no conversion)
fromUTC :: Time.UTCTime -> Time.TimeZone -> Time.ZonedTime
fromUTC (Time.UTCTime day diffTime) timeZone = Time.ZonedTime localTime timeZone
  where
    localTime = Time.LocalTime day timeOfDay
    timeOfDay = Time.timeToTimeOfDay diffTime

-- | Given a LocalTime, build a UTCTime (no conversion)
toUTC :: Time.LocalTime -> Time.UTCTime
toUTC (Time.LocalTime day timeOfDay) = Time.UTCTime day diffTime
  where
    diffTime = Time.timeOfDayToTime timeOfDay


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

module Duckling.Rules
  ( allRules
  , rulesFor
  ) where

import Data.HashSet (HashSet)
import Prelude
import qualified Data.HashSet as HashSet

import Duckling.Dimensions
import Duckling.Dimensions.Types
import Duckling.Locale
import Duckling.Types
import qualified Duckling.Rules.AF as AFRules
import qualified Duckling.Rules.AR as ARRules
import qualified Duckling.Rules.Common as CommonRules
import qualified Duckling.Rules.BG as BGRules
import qualified Duckling.Rules.BN as BNRules
import qualified Duckling.Rules.CA as CARules
import qualified Duckling.Rules.CS as CSRules
import qualified Duckling.Rules.DA as DARules
import qualified Duckling.Rules.DE as DERules
import qualified Duckling.Rules.EL as ELRules
import qualified Duckling.Rules.EN as ENRules
import qualified Duckling.Rules.ES as ESRules
import qualified Duckling.Rules.ET as ETRules
import qualified Duckling.Rules.FI as FIRules
import qualified Duckling.Rules.FA as FARules
import qualified Duckling.Rules.FR as FRRules
import qualified Duckling.Rules.GA as GARules
import qualified Duckling.Rules.HE as HERules
import qualified Duckling.Rules.HI as HIRules
import qualified Duckling.Rules.HR as HRRules
import qualified Duckling.Rules.HU as HURules
import qualified Duckling.Rules.ID as IDRules
import qualified Duckling.Rules.IS as ISRules
import qualified Duckling.Rules.IT as ITRules
import qualified Duckling.Rules.JA as JARules
import qualified Duckling.Rules.KA as KARules
import qualified Duckling.Rules.KM as KMRules
import qualified Duckling.Rules.KN as KNRules
import qualified Duckling.Rules.KO as KORules
import qualified Duckling.Rules.LO as LORules
import qualified Duckling.Rules.ML as MLRules
import qualified Duckling.Rules.MN as MNRules
import qualified Duckling.Rules.MY as MYRules
import qualified Duckling.Rules.NB as NBRules
import qualified Duckling.Rules.NE as NERules
import qualified Duckling.Rules.NL as NLRules
import qualified Duckling.Rules.PL as PLRules
import qualified Duckling.Rules.PT as PTRules
import qualified Duckling.Rules.RO as RORules
import qualified Duckling.Rules.RU as RURules
import qualified Duckling.Rules.SK as SKRules
import qualified Duckling.Rules.SV as SVRules
import qualified Duckling.Rules.SW as SWRules
import qualified Duckling.Rules.TA as TARules
import qualified Duckling.Rules.TE as TERules
import qualified Duckling.Rules.TH as THRules
import qualified Duckling.Rules.TR as TRRules
import qualified Duckling.Rules.UK as UKRules
import qualified Duckling.Rules.VI as VIRules
import qualified Duckling.Rules.ZH as ZHRules

-- | Returns the minimal set of rules required for `targets`.
rulesFor :: Locale -> HashSet (Seal Dimension) -> [Rule]
rulesFor locale targets
  | HashSet.null targets = allRules locale
  | otherwise = [ rules | dims <- HashSet.toList $ explicitDimensions targets
                        , rules <- rulesFor' locale dims ]

-- | Returns all the rules for the provided locale.
-- We can't really use `allDimensions` as-is, since `TimeGrain` is not present.
allRules :: Locale -> [Rule]
allRules locale@(Locale lang _) = concatMap (rulesFor' locale) . HashSet.toList
  . explicitDimensions . HashSet.fromList $ allDimensions lang

rulesFor' :: Locale -> Seal Dimension -> [Rule]
rulesFor' (Locale lang (Just region)) dim =
  CommonRules.rules dim ++ langRules lang dim ++ localeRules lang region dim
rulesFor' (Locale lang Nothing) dim =
  CommonRules.rules dim ++ defaultRules lang dim

-- | Default rules when no locale, for backward compatibility.
defaultRules :: Lang -> Seal Dimension -> [Rule]
defaultRules AF = AFRules.defaultRules
defaultRules AR = ARRules.defaultRules
defaultRules BG = BGRules.defaultRules
defaultRules BN = BNRules.defaultRules
defaultRules CA = CARules.defaultRules
defaultRules CS = CSRules.defaultRules
defaultRules DA = DARules.defaultRules
defaultRules DE = DERules.defaultRules
defaultRules EL = ELRules.defaultRules
defaultRules EN = ENRules.defaultRules
defaultRules ES = ESRules.defaultRules
defaultRules ET = ETRules.defaultRules
defaultRules FI = FIRules.defaultRules
defaultRules FA = FARules.defaultRules
defaultRules FR = FRRules.defaultRules
defaultRules GA = GARules.defaultRules
defaultRules HE = HERules.defaultRules
defaultRules HI = HIRules.defaultRules
defaultRules HR = HRRules.defaultRules
defaultRules HU = HURules.defaultRules
defaultRules ID = IDRules.defaultRules
defaultRules IS = ISRules.defaultRules
defaultRules IT = ITRules.defaultRules
defaultRules JA = JARules.defaultRules
defaultRules KA = KARules.defaultRules
defaultRules KM = KMRules.defaultRules
defaultRules KN = KNRules.defaultRules
defaultRules KO = KORules.defaultRules
defaultRules LO = LORules.defaultRules
defaultRules ML = MLRules.defaultRules
defaultRules MN = MNRules.defaultRules
defaultRules MY = MYRules.defaultRules
defaultRules NB = NBRules.defaultRules
defaultRules NE = NERules.defaultRules
defaultRules NL = NLRules.defaultRules
defaultRules PL = PLRules.defaultRules
defaultRules PT = PTRules.defaultRules
defaultRules RO = RORules.defaultRules
defaultRules RU = RURules.defaultRules
defaultRules SK = SKRules.defaultRules
defaultRules SV = SVRules.defaultRules
defaultRules SW = SWRules.defaultRules
defaultRules TA = TARules.defaultRules
defaultRules TE = TERules.defaultRules
defaultRules TH = THRules.defaultRules
defaultRules TR = TRRules.defaultRules
defaultRules UK = UKRules.defaultRules
defaultRules VI = VIRules.defaultRules
defaultRules ZH = ZHRules.defaultRules

localeRules :: Lang -> Region -> Seal Dimension -> [Rule]
localeRules AF = AFRules.localeRules
localeRules AR = ARRules.localeRules
localeRules BG = BGRules.localeRules
localeRules BN = BNRules.localeRules
localeRules CA = CARules.localeRules
localeRules CS = CSRules.localeRules
localeRules DA = DARules.localeRules
localeRules DE = DERules.localeRules
localeRules EL = ELRules.localeRules
localeRules EN = ENRules.localeRules
localeRules ES = ESRules.localeRules
localeRules ET = ETRules.localeRules
localeRules FI = FIRules.localeRules
localeRules FA = FARules.localeRules
localeRules FR = FRRules.localeRules
localeRules GA = GARules.localeRules
localeRules HE = HERules.localeRules
localeRules HI = HIRules.localeRules
localeRules HR = HRRules.localeRules
localeRules HU = HURules.localeRules
localeRules ID = IDRules.localeRules
localeRules IS = ISRules.localeRules
localeRules IT = ITRules.localeRules
localeRules JA = JARules.localeRules
localeRules KA = KARules.localeRules
localeRules KM = KMRules.localeRules
localeRules KN = KNRules.localeRules
localeRules KO = KORules.localeRules
localeRules LO = LORules.localeRules
localeRules ML = MLRules.localeRules
localeRules MN = MNRules.localeRules
localeRules MY = MYRules.localeRules
localeRules NB = NBRules.localeRules
localeRules NE = NERules.localeRules
localeRules NL = NLRules.localeRules
localeRules PL = PLRules.localeRules
localeRules PT = PTRules.localeRules
localeRules RO = RORules.localeRules
localeRules RU = RURules.localeRules
localeRules SK = SKRules.localeRules
localeRules SV = SVRules.localeRules
localeRules SW = SWRules.localeRules
localeRules TA = TARules.localeRules
localeRules TE = TERules.localeRules
localeRules TH = THRules.localeRules
localeRules TR = TRRules.localeRules
localeRules UK = UKRules.localeRules
localeRules VI = VIRules.localeRules
localeRules ZH = ZHRules.localeRules

langRules :: Lang -> Seal Dimension -> [Rule]
langRules AF = AFRules.langRules
langRules AR = ARRules.langRules
langRules BG = BGRules.langRules
langRules BN = BNRules.langRules
langRules CA = CARules.langRules
langRules CS = CSRules.langRules
langRules DA = DARules.langRules
langRules DE = DERules.langRules
langRules EL = ELRules.langRules
langRules EN = ENRules.langRules
langRules ES = ESRules.langRules
langRules ET = ETRules.langRules
langRules FI = FIRules.langRules
langRules FA = FARules.langRules
langRules FR = FRRules.langRules
langRules GA = GARules.langRules
langRules HE = HERules.langRules
langRules HI = HIRules.langRules
langRules KN = KNRules.langRules
langRules HR = HRRules.langRules
langRules HU = HURules.langRules
langRules ID = IDRules.langRules
langRules IS = ISRules.langRules
langRules IT = ITRules.langRules
langRules JA = JARules.langRules
langRules KA = KARules.langRules
langRules KM = KMRules.langRules
langRules KO = KORules.langRules
langRules LO = LORules.langRules
langRules ML = MLRules.langRules
langRules MN = MNRules.langRules
langRules MY = MYRules.langRules
langRules NB = NBRules.langRules
langRules NE = NERules.langRules
langRules NL = NLRules.langRules
langRules PL = PLRules.langRules
langRules PT = PTRules.langRules
langRules RO = RORules.langRules
langRules RU = RURules.langRules
langRules SK = SKRules.langRules
langRules SV = SVRules.langRules
langRules SW = SWRules.langRules
langRules TA = TARules.langRules
langRules TE = TERules.langRules
langRules TH = THRules.langRules
langRules TR = TRRules.langRules
langRules UK = UKRules.langRules
langRules VI = VIRules.langRules
langRules ZH = ZHRules.langRules


-- 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 AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NamedFieldPuns #-}

module Duckling.Types where

import Control.DeepSeq
import Data.Aeson
import Data.GADT.Compare
import Data.GADT.Show
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.List (intersperse, sortOn)
import Data.Maybe
import Data.Text (Text, toLower, unpack)
import Data.Typeable ((:~:)(Refl), eqT, Typeable)
import GHC.Generics
import Prelude
import TextShow (TextShow(..))
import qualified Data.ByteString.Lazy as LB
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as TT
import qualified Data.Text.Encoding as Text
import qualified Text.Regex.Base as R
import qualified Text.Regex.PCRE as PCRE
import qualified TextShow as TS

import Duckling.AmountOfMoney.Types (AmountOfMoneyData)
import Duckling.CreditCardNumber.Types (CreditCardNumberData)
import Duckling.Distance.Types (DistanceData)
import Duckling.Duration.Types (DurationData)
import Duckling.Email.Types (EmailData)
import Duckling.Locale
import Duckling.Numeral.Types (NumeralData)
import Duckling.Ordinal.Types (OrdinalData)
import Duckling.PhoneNumber.Types (PhoneNumberData)
import Duckling.Quantity.Types (QuantityData)
import Duckling.Regex.Types
import Duckling.Resolve
import Duckling.Temperature.Types (TemperatureData)
import Duckling.Time.Types (TimeData)
import Duckling.TimeGrain.Types (Grain)
import Duckling.Url.Types (UrlData)
import Duckling.Volume.Types (VolumeData)

-- -----------------------------------------------------------------
-- Token

data Token = forall a . (Resolve a, Eq a, Hashable a, Show a, NFData a) =>
  Token (Dimension a) a

deriving instance Show Token
instance Eq Token where
  Token d1 v1 == Token d2 v2 = case geq d1 d2 of
    Just Refl -> v1 == v2
    Nothing   -> False

instance Hashable Token where
  hashWithSalt s (Token d v) = hashWithSalt s (d, v)

instance NFData Token where
  rnf (Token _ v) = rnf v

-- -----------------------------------------------------------------
-- Seal

data Seal s where
  Seal :: s a -> Seal s

instance GEq s => Eq (Seal s) where
  Seal x == Seal y =
    defaultEq x y

instance GShow s => Show (Seal s) where
  showsPrec p (Seal s)
    = showParen (p > 10) (showString "Seal " . gshowsPrec 11 s)

withSeal :: Seal s -> (forall t. s t -> r) -> r
withSeal (Seal x) f = f x

-- -----------------------------------------------------------------
-- Dimension

class (Show a, Typeable a, Typeable (DimensionData  a)) =>
    CustomDimension a where
  type DimensionData a
  dimRules :: a -> [Rule]
  dimLangRules :: Lang -> a -> [Rule]
  dimLocaleRules :: Region -> a -> [Rule]
  dimDependents :: a -> HashSet (Seal Dimension)

-- | GADT for differentiating between dimensions
-- Each dimension should have its own constructor and provide the data structure
-- for its parsed data
data Dimension a where
  RegexMatch :: Dimension GroupMatch
  AmountOfMoney :: Dimension AmountOfMoneyData
  CreditCardNumber :: Dimension CreditCardNumberData
  Distance :: Dimension DistanceData
  Duration :: Dimension DurationData
  Email :: Dimension EmailData
  Numeral :: Dimension NumeralData
  Ordinal :: Dimension OrdinalData
  PhoneNumber :: Dimension PhoneNumberData
  Quantity :: Dimension QuantityData
  Temperature :: Dimension TemperatureData
  Time :: Dimension TimeData
  TimeGrain :: Dimension Grain
  Url :: Dimension UrlData
  Volume :: Dimension VolumeData
  CustomDimension :: CustomDimension a => a -> Dimension (DimensionData a)

-- Show
instance Show (Dimension a) where
  show RegexMatch = "RegexMatch"
  show CreditCardNumber = "CreditCardNumber"
  show Distance = "Distance"
  show Duration = "Duration"
  show Email = "Email"
  show AmountOfMoney = "AmountOfMoney"
  show Numeral = "Numeral"
  show Ordinal = "Ordinal"
  show PhoneNumber = "PhoneNumber"
  show Quantity = "Quantity"
  show Temperature = "Temperature"
  show Time = "Time"
  show TimeGrain = "TimeGrain"
  show Url = "Url"
  show Volume = "Volume"
  show (CustomDimension d) = show d
instance GShow Dimension where gshowsPrec = showsPrec

-- TextShow
instance TextShow (Dimension a) where
  showb d = TS.fromString $ show d
instance TextShow (Seal Dimension) where
  showb (Seal d) = showb d

-- Hashable
instance Hashable (Seal Dimension) where
  hashWithSalt s (Seal a) = hashWithSalt s a
instance Hashable (Dimension a) where
  hashWithSalt s RegexMatch          = hashWithSalt s (0::Int)
  hashWithSalt s Distance            = hashWithSalt s (1::Int)
  hashWithSalt s Duration            = hashWithSalt s (2::Int)
  hashWithSalt s Email               = hashWithSalt s (3::Int)
  hashWithSalt s AmountOfMoney       = hashWithSalt s (4::Int)
  hashWithSalt s Numeral             = hashWithSalt s (5::Int)
  hashWithSalt s Ordinal             = hashWithSalt s (6::Int)
  hashWithSalt s PhoneNumber         = hashWithSalt s (7::Int)
  hashWithSalt s Quantity            = hashWithSalt s (8::Int)
  hashWithSalt s Temperature         = hashWithSalt s (9::Int)
  hashWithSalt s Time                = hashWithSalt s (10::Int)
  hashWithSalt s TimeGrain           = hashWithSalt s (11::Int)
  hashWithSalt s Url                 = hashWithSalt s (12::Int)
  hashWithSalt s Volume              = hashWithSalt s (13::Int)
  hashWithSalt s (CustomDimension _) = hashWithSalt s (14::Int)
  hashWithSalt s CreditCardNumber    = hashWithSalt s (15::Int)

instance GEq Dimension where
  geq RegexMatch RegexMatch = Just Refl
  geq RegexMatch _ = Nothing
  geq CreditCardNumber CreditCardNumber = Just Refl
  geq CreditCardNumber _ = Nothing
  geq Distance Distance = Just Refl
  geq Distance _ = Nothing
  geq Duration Duration = Just Refl
  geq Duration _ = Nothing
  geq Email Email = Just Refl
  geq Email _ = Nothing
  geq AmountOfMoney AmountOfMoney = Just Refl
  geq AmountOfMoney _ = Nothing
  geq Numeral Numeral = Just Refl
  geq Numeral _ = Nothing
  geq Ordinal Ordinal = Just Refl
  geq Ordinal _ = Nothing
  geq PhoneNumber PhoneNumber = Just Refl
  geq PhoneNumber _ = Nothing
  geq Quantity Quantity = Just Refl
  geq Quantity _ = Nothing
  geq Temperature Temperature = Just Refl
  geq Temperature _ = Nothing
  geq Time Time = Just Refl
  geq Time _ = Nothing
  geq TimeGrain TimeGrain = Just Refl
  geq TimeGrain _ = Nothing
  geq Url Url = Just Refl
  geq Url _ = Nothing
  geq Volume Volume = Just Refl
  geq Volume _ = Nothing
  geq (CustomDimension (_ :: a)) (CustomDimension (_ :: b))
    | Just Refl <- eqT :: Maybe (a :~: b) = Just Refl
  geq (CustomDimension _) _ = Nothing

isDimension :: Dimension a -> Token -> Bool
isDimension dim (Token dim' _) = isJust $ geq dim dim'

data ResolvedVal
  = forall a . ( Resolve a, Eq (ResolvedValue a)
               , Show (ResolvedValue a)
               , ToJSON (ResolvedValue a)) =>
    RVal (Dimension a) (ResolvedValue a)

deriving instance Show ResolvedVal

instance Eq ResolvedVal where
  RVal d1 v1 == RVal d2 v2
    | Just Refl <- geq d1 d2 = v1 == v2
    | otherwise = False

data Node = Node
  { nodeRange :: Range
  , token     :: Token
  , children  :: [Node]
  , rule      :: Maybe Text
  } deriving (Eq, Generic, Hashable, Show, NFData)

data ResolvedToken = Resolved
  { range :: Range
  , node :: Node
  , rval :: ResolvedVal
  , isLatent :: Bool
  } deriving (Eq, Show)

instance Ord ResolvedToken where
  compare (Resolved range1 _ (RVal _ v1) latent1)
          (Resolved range2 _ (RVal _ v2) latent2) =
    case compare range1 range2 of
      EQ -> case compare (toJText v1) (toJText v2) of
        EQ -> compare latent1 latent2
        z -> z
      z  -> z

data Range = Range Int Int
  deriving (Eq, Ord, Generic, Hashable, Show, NFData)

type Production = [Token] -> Maybe Token
type Predicate = Token -> Bool
data PatternItem = Regex PCRE.Regex | Predicate Predicate

type Pattern = [PatternItem]

data Rule = Rule
  { name :: Text
  , pattern :: Pattern
  , prod :: Production
  }

instance Show Rule where
  show Rule{ name } = show name

data Entity = Entity
  { dim    :: Text
  , body   :: Text
  , value  :: ResolvedVal
  , start  :: Int
  , end    :: Int
  , latent :: Bool
  , enode  :: Node
  } deriving (Eq, Generic, Show)

instance ToJSON Entity where
  toJSON ent@Entity{value = RVal _ val} = object
    [ "dim"    .= dim ent
    , "body"   .= body ent
    , "value"  .= val
    , "start"  .= start ent
    , "end"    .= end ent
    , "latent" .= latent ent
    ]

toJText :: ToJSON x => x -> Text
toJText = Text.decodeUtf8 . LB.toStrict . encode

-- -----------------------------------------------------------------
-- Predicates helpers

regex :: String -> PatternItem
regex = Regex . R.makeRegexOpts compOpts execOpts
  where
    compOpts = PCRE.defaultCompOpt + PCRE.compCaseless + PCRE.compUTF8
    execOpts = PCRE.defaultExecOpt

dimension :: Typeable a => Dimension a -> PatternItem
dimension d = Predicate $ isDimension d

-- -----------------------------------------------------------------
-- Rule Construction helpers

singleStringLookupRule :: HashMap Text a -> Text -> (a -> Maybe Token) -> Rule
singleStringLookupRule hashMap name production = Rule
  { name
  , pattern = [ regex $ unpack regexString ]
  , prod = \case
      (Token RegexMatch (GroupMatch (match:_)):_) ->
        HashMap.lookup (toLower match) hashMap >>= production
      _ -> Nothing
  }
  where
    regexString =
      "(" <> mconcat
      (intersperse "|" $ sortOn (negate . TT.length) $ HashMap.keys hashMap)
      <> ")"


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

module Duckling.AmountOfMoney.Helpers
  ( currencyOnly
  , valueOnly
  , isSimpleAmountOfMoney
  , isCent
  , isCents
  , isDollarCoin
  , isCurrencyOnly
  , isDime
  , isMoneyWithValue
  , isWithoutCents
  , withCents
  , withInterval
  , withMax
  , withMin
  , withValue
  , mkLatent
  , dollarCoins
  )
  where

import Data.HashMap.Strict (HashMap)
import Data.Maybe (isJust)
import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Types
  ( Currency (..)
  , AmountOfMoneyData (..)
  , amountOfMoneyData'
  )
import Duckling.Numeral.Types (getIntValue, isInteger)
import Duckling.Dimensions.Types
import Duckling.Types hiding (Entity(..))

import qualified Data.HashMap.Strict as HashMap

-- -----------------------------------------------------------------
-- Dollar coin Types

dollarCoins :: HashMap Text Double
dollarCoins = HashMap.fromList
  [ ("nickel", 0.05)
  , ("nickels", 0.05)
  , ("dime", 0.1)
  , ("dimes", 0.1)
  , ("quarter", 0.25)
  , ("quarters", 0.25)
  ]

-- -----------------------------------------------------------------
-- Patterns

isCents :: Predicate
isCents (Token AmountOfMoney AmountOfMoneyData{value = Just _, currency = Cent}) = True
isCents _ = False

isWithoutCents :: Predicate
isWithoutCents (Token AmountOfMoney AmountOfMoneyData{currency = Cent}) = False
isWithoutCents (Token AmountOfMoney AmountOfMoneyData{value = Just v}) = isInteger v
isWithoutCents _ = False

isMoneyWithValue :: Predicate
isMoneyWithValue (Token AmountOfMoney AmountOfMoneyData{value = v1, minValue = v2, maxValue = v3}) =
 any isJust [v1, v2, v3]
isMoneyWithValue _ = False

isCurrencyOnly :: Predicate
isCurrencyOnly (Token AmountOfMoney AmountOfMoneyData
  {value = Nothing, minValue = Nothing, maxValue = Nothing}) = True
isCurrencyOnly _ = False

isDollarCoin :: Predicate
isDollarCoin (Token AmountOfMoney AmountOfMoneyData{value = Just d, currency}) =
  elem d [0.05, 0.1, 0.25] && elem currency [Dollar, AUD, CAD, JMD,
                                             NZD,    SGD, TTD, USD]
isDollarCoin _ = False

isSimpleAmountOfMoney :: Predicate
isSimpleAmountOfMoney (Token AmountOfMoney AmountOfMoneyData
  {value = Just _, minValue = Nothing, maxValue = Nothing}) = True
isSimpleAmountOfMoney _ = False

isDime :: Predicate
isDime (Token AmountOfMoney AmountOfMoneyData
  {value = Just d, currency = Cent}) =
  maybe False (\i -> (i `mod` 10) == 0) $ getIntValue d
isDime _ = False

isCent :: Predicate
isCent (Token AmountOfMoney AmountOfMoneyData
  {value = Just c, currency = Cent}) =
  maybe False (\i -> i >= 0 && i <= 9) $ getIntValue c
isCent _ = False

-- -----------------------------------------------------------------
-- Production

currencyOnly :: Currency -> AmountOfMoneyData
currencyOnly c = amountOfMoneyData'{currency = c}

valueOnly :: Double -> AmountOfMoneyData
valueOnly x = amountOfMoneyData'{value = Just x}

withValue :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withValue x fd = fd {value = Just x}

withCents :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withCents x fd@AmountOfMoneyData {value = Just value} = fd
  {value = Just $ value + x / 100}
withCents x AmountOfMoneyData {value = Nothing} =
  amountOfMoneyData'{value = Just x, currency = Cent}

withInterval :: (Double, Double) -> AmountOfMoneyData -> AmountOfMoneyData
withInterval (from, to) fd = fd
  {minValue = Just from, maxValue = Just to, value = Nothing}

withMin :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMin x fd = fd {minValue = Just x}

withMax :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMax x fd = fd {maxValue = Just x}

mkLatent :: AmountOfMoneyData -> AmountOfMoneyData
mkLatent fd = fd {latent = True}


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

module Duckling.AmountOfMoney.Rules
  ( rules
  ) where

import Data.HashMap.Strict (HashMap)
import Data.Maybe
import Data.String
import Data.Text (Text)
import Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text

import Duckling.AmountOfMoney.Helpers
import Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))
import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers (isPositive)
import Duckling.Numeral.Types (NumeralData (..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.AmountOfMoney.Types as TAmountOfMoney
import qualified Duckling.Numeral.Types as TNumeral

currencies :: HashMap Text Currency
currencies = HashMap.fromList
  [ ("aed", AED)
  , ("aud", AUD)
  , ("bgn", BGN)
  , ("brl", BRL)
  , ("byn", BYN)
  , ("cad", CAD)
  , ("Â¢", Cent)
  , ("c", Cent)
  , ("chf", CHF)
  , ("cny", CNY)
  , ("czk", CZK)
  , ("rmb", CNY)
  , ("yuan", CNY)
  , ("$", Dollar)
  , ("dinar", Dinar)
  , ("dinars", Dinar)
  , ("dkk", DKK)
  , ("dollar", Dollar)
  , ("dollars", Dollar)
  , ("egp", EGP)
  , ("â‚¬", EUR)
  , ("eur", EUR)
  , ("euro", EUR)
  , ("euros", EUR)
  , ("eurs", EUR)
  , ("â‚¬ur", EUR)
  , ("â‚¬uro", EUR)
  , ("â‚¬uros", EUR)
  , ("â‚¬urs", EUR)
  , ("gbp", GBP)
  , ("gel", GEL)
  , ("hkd", HKD)
  , ("hrk", HRK)
  , ("idr", IDR)
  , ("ils", ILS)
  , ("â‚ª", ILS)
  , ("nis", ILS)
  , ("inr", INR)
  , ("iqd", IQD)
  , ("rs", INR)
  , ("rs.", INR)
  , ("rupee", INR)
  , ("rupees", INR)
  , ("jmd", JMD)
  , ("jod", JOD)
  , ("Â¥", JPY)
  , ("jpy", JPY)
  , ("lari", GEL)
  , ("\x20BE", GEL)
  , ("yen", JPY)
  , ("krw", KRW)
  , ("kwd", KWD)
  , ("lbp", LBP)
  , ("mad", MAD)
  , ("mnt", MNT)
  , ("myr", MYR)
  , ("rm", MYR)
  , ("â‚®", MNT)
  , ("tugrik", MNT)
  , ("tugriks", MNT)
  , ("nok", NOK)
  , ("nzd", NZD)
  , ("pkr", PKR)
  , ("pln", PLN)
  , ("Â£", Pound)
  , ("pt", PTS)
  , ("pta", PTS)
  , ("ptas", PTS)
  , ("pts", PTS)
  , ("qar", QAR)
  , ("â‚½", RUB)
  , ("rial", Rial)
  , ("rials", Rial)
  , ("riyal", Riyal)
  , ("riyals", Riyal)
  , ("ron", RON)
  , ("rub", RUB)
  , ("sar", SAR)
  , ("sek", SEK)
  , ("sgd", SGD)
  , ("shekel", ILS)
  , ("shekels", ILS)
  , ("thb", THB)
  , ("ttd", TTD)
  , ("â‚´", UAH)
  , ("uah", UAH)
  , ("usd", USD)
  , ("us$", USD)
  , ("vnd", VND)
  , ("zar", ZAR)
  , ("tl", TRY)
  , ("lira", TRY)
  , ("â‚º", TRY)
  ]

ruleCurrencies :: Rule
ruleCurrencies = Rule
  { name = "currencies"
  , pattern =
    [ regex "(aed|aud|bgn|brl|byn|Â¢|cad|chf|cny|c|\\$|dinars?|dkk|dollars?|egp|(e|â‚¬)uro?s?|â‚¬|gbp|gel|\x20BE|hkd|hrk|idr|ils|â‚ª|inr|iqd|jmd|jod|Â¥|jpy|lari|krw|kwd|lbp|mad|â‚®|mnt|tugriks?|myr|rm|nis|nok|nzd|Â£|pkr|pln|pta?s?|qar|â‚½|rs\\.?|riy?als?|ron|rub|rupees?|sar|sek|sgb|shekels?|thb|ttd|â‚´|uah|us(d|\\$)|vnd|yen|yuan|zar|tl|lira|â‚º)"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> do
        c <- HashMap.lookup (Text.toLower match) currencies
        Just . Token AmountOfMoney $ currencyOnly c
      _ -> Nothing
  }

ruleAmountUnit :: Rule
ruleAmountUnit = Rule
  { name = "<amount> <unit>"
  , pattern =
    [ Predicate isPositive
    , Predicate isCurrencyOnly
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = v}:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:
       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c
      _ -> Nothing
  }

ruleAmountLatent :: Rule
ruleAmountLatent = Rule
  { name = "<amount> (latent)"
  , pattern =
    [ Predicate isPositive
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = v}:_) ->
        Just . Token AmountOfMoney . mkLatent $ valueOnly v
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleAmountUnit
  , ruleAmountLatent
  , ruleCurrencies
  ]


-- 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 DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Duckling.AmountOfMoney.Types where

import Control.DeepSeq
import Data.Aeson
import Data.Hashable
import Data.Text (Text)
import GHC.Generics
import Prelude
import qualified Data.HashMap.Strict as H

import Duckling.Resolve (Resolve(..), Options(..))

data Currency
  -- ambiguous
  = Cent
  | Dinar
  | Dirham
  | Dollar
  | Pound
  | Rial
  | Riyal
  | Unnamed -- e.g. bucks
  -- unambiguous
  | AED
  | AUD
  | BGN
  | BRL
  | BYN
  | CAD
  | CHF
  | CNY
  | CZK
  | DKK
  | EGP
  | EUR
  | GBP
  | HKD
  | HRK
  | IDR
  | ILS
  | INR
  | IQD
  | JMD
  | JOD
  | JPY
  | GEL
  | KRW
  | KWD
  | LBP
  | MAD
  | MNT
  | MYR
  | NOK
  | NZD
  | PKR
  | PLN
  | PTS
  | QAR
  | RON
  | RUB
  | SAR
  | SEK
  | SGD
  | THB
  | TTD
  | USD
  | VND
  | ZAR
  | UAH
  | TRY
  deriving (Eq, Generic, Hashable, Show, Ord, NFData)

instance ToJSON Currency where
  toJSON Cent    = "cent"
  toJSON Dollar  = "$"
  toJSON Pound   = "\x00a3"
  toJSON Dinar   = "dinar"
  toJSON Dirham  = "dirham"
  toJSON Rial    = "rial"
  toJSON Riyal   = "riyal"
  toJSON Unnamed = "unknown"
  toJSON AED     = "AED"
  toJSON AUD     = "AUD"
  toJSON BGN     = "BGN"
  toJSON BRL     = "BRL"
  toJSON BYN     = "BYN"
  toJSON CAD     = "CAD"
  toJSON CHF     = "CHF"
  toJSON CNY     = "CNY"
  toJSON CZK     = "CZK"
  toJSON DKK     = "DKK"
  toJSON EGP     = "EGP"
  toJSON EUR     = "EUR"
  toJSON GBP     = "GBP"
  toJSON HKD     = "HKD"
  toJSON HRK     = "HRK"
  toJSON IDR     = "IDR"
  toJSON ILS     = "ILS"
  toJSON IQD     = "IQD"
  toJSON INR     = "INR"
  toJSON JMD     = "JMD"
  toJSON JOD     = "JOD"
  toJSON JPY     = "JPY"
  toJSON GEL     = "GEL"
  toJSON KRW     = "KRW"
  toJSON KWD     = "KWD"
  toJSON LBP     = "LBP"
  toJSON MAD     = "MAD"
  toJSON MNT     = "MNT"
  toJSON MYR     = "MYR"
  toJSON NOK     = "NOK"
  toJSON NZD     = "NZD"
  toJSON PTS     = "PTS"
  toJSON PKR     = "PKR"
  toJSON PLN     = "PLN"
  toJSON QAR     = "QAR"
  toJSON RON     = "RON"
  toJSON RUB     = "RUB"
  toJSON SAR     = "SAR"
  toJSON SEK     = "SEK"
  toJSON SGD     = "SGD"
  toJSON THB     = "THB"
  toJSON TTD     = "TTD"
  toJSON USD     = "USD"
  toJSON VND     = "VND"
  toJSON ZAR     = "ZAR"
  toJSON UAH     = "UAH"
  toJSON TRY     = "TRY"

data AmountOfMoneyData = AmountOfMoneyData
  { value    :: Maybe Double
  , currency :: Currency
  , minValue :: Maybe Double
  , maxValue :: Maybe Double
  , latent   :: Bool
  }
  deriving (Eq, Generic, Hashable, Show, Ord, NFData)

instance Resolve AmountOfMoneyData where
  type ResolvedValue AmountOfMoneyData = AmountOfMoneyValue
  resolve _ Options {withLatent = False} AmountOfMoneyData {latent = True} =
    Nothing
  resolve _ _ AmountOfMoneyData {value = Nothing, minValue = Nothing
                              , maxValue = Nothing} =
    Nothing
  resolve _ _ AmountOfMoneyData {value = Just value, currency, latent} =
    Just (simple currency value, latent)
  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
                              , minValue = Just from, maxValue = Just to
                              , latent} =
    Just (between c (from, to), latent)
  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
                              , minValue = Just v, maxValue = Nothing
                              , latent} =
    Just (above c v, latent)
  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
                              , minValue = Nothing, maxValue = Just v
                              , latent} =
    Just (under c v, latent)

amountOfMoneyData' :: AmountOfMoneyData
amountOfMoneyData' = AmountOfMoneyData
  { value = Nothing
  , currency = Unnamed
  , minValue = Nothing
  , maxValue = Nothing
  , latent = False
  }

data IntervalDirection = Above | Under
  deriving (Eq, Generic, Hashable, Ord, Show, NFData)

data SingleValue = SingleValue
  { vCurrency :: Currency
  , vValue    :: Double
  }
  deriving (Eq, Show)

instance ToJSON SingleValue where
  toJSON SingleValue {vCurrency, vValue} = object
    [ "value" .= vValue
    , "unit"  .= vCurrency
    ]

data AmountOfMoneyValue
  = SimpleValue SingleValue
  | IntervalValue (SingleValue, SingleValue)
  | OpenIntervalValue (SingleValue, IntervalDirection)
  deriving (Show, Eq)

instance ToJSON AmountOfMoneyValue where
  toJSON (SimpleValue value) = case toJSON value of
    Object o -> Object $ H.insert "type" (toJSON ("value" :: Text)) o
    _ -> Object H.empty
  toJSON (IntervalValue (from, to)) = object
    [ "type" .= ("interval" :: Text)
    , "from" .= toJSON from
    , "to" .= toJSON to
    ]
  toJSON (OpenIntervalValue (from, Above)) = object
    [ "type" .= ("interval" :: Text)
    , "from" .= toJSON from
    ]
  toJSON (OpenIntervalValue (to, Under)) = object
    [ "type" .= ("interval" :: Text)
    , "to" .= toJSON to
    ]

-- -----------------------------------------------------------------
-- Value helpers

simple :: Currency -> Double -> AmountOfMoneyValue
simple c v = SimpleValue $ single c v

between :: Currency -> (Double, Double) -> AmountOfMoneyValue
between c (from, to) = IntervalValue (single c from, single c to)

above :: Currency -> Double -> AmountOfMoneyValue
above = openInterval Above

under :: Currency -> Double -> AmountOfMoneyValue
under = openInterval Under

openInterval :: IntervalDirection -> Currency -> Double -> AmountOfMoneyValue
openInterval direction c v = OpenIntervalValue (single c v, direction)

single :: Currency -> Double -> SingleValue
single c v = SingleValue {vCurrency = c, vValue = v}


-- 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.AmountOfMoney.AR.Corpus
  ( corpus
  ) where

import Data.String
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Locale
import Duckling.Resolve
import Duckling.Testing.Types

corpus :: Corpus
corpus = (testContext {locale = makeLocale AR Nothing},
  testOptions, allExamples)

allExamples :: [Example]
allExamples = concat
  [ examples (simple Dollar 1)
             [ "$1"
             , "1 Ø¯ÙˆÙ„Ø§Ø±"
             ]
  , examples (simple Dollar 10)
             [ "$10"
             , "$ 10"
             , "10 $"
             , "10$"
             , "10$"
             , "10 Ø¯ÙˆÙ„Ø§Ø±"
             , "Ø¹Ø´Ø±Ø© Ø¯ÙˆÙ„Ø§Ø±Ø§Øª"
             ]
  , examples (simple Cent 10)
             [ "10 Ø³Ù†ØªØ§Øª"
             , "10 Ø³Ù†Øª"
             , "10 Ø³ÙŠÙ†Øª"
             , "10 Ø³ÙŠÙ†ØªØ§Øª"
             , "10 c"
             , "10Â¢"
             ]
  , examples (simple Dollar 1e4)
             [ "10000 Ø¯ÙˆÙ„Ø§Ø±"
             , "$10,000"
             , "10000$"
             ]
  , examples (simple EUR 20)
             [ "20 ÙŠÙˆØ±Ùˆ"
             , "20 Ø§ÙˆØ±Ùˆ"
             , "20 Ø£ÙˆØ±Ùˆ"
             , "20â‚¬"
             , "20 â‚¬"
             ]
  , examples (simple Pound 10)
             [ "10 Ø¬Ù†ÙŠÙ‡"
             , "10 Ø¬Ù†ÙŠÙ‡Ø§Øª"
             ]
  , examples (simple Dollar 20.43)
             [ "20$ Ùˆ 43c"
             , "$20 43"
             , "20$ 43c"
             , "20 Ø¯ÙˆÙ„Ø§Ø± Ùˆ43 Ø³Ù†Øª"
             , "20.43 $"
             ]
  , examples (simple GBP 3)
             [ "3 Ø¬Ù†ÙŠÙ‡Ø§Øª Ø§Ø³ØªØ±Ù„ÙŠÙ†ÙŠØ©"
             , "3 Ø¬Ù†ÙŠÙ‡ Ø§Ø³ØªØ±Ù„ÙŠÙ†ÙŠ"
             ]
  , examples (simple KWD 42)
             [ "42 KWD"
             , "42 Ø¯ÙŠÙ†Ø§Ø± ÙƒÙˆÙŠØªÙŠ"
             ]
  , examples (simple LBP 42)
             [ "42 LBP"
             , "42 Ù„ÙŠØ±Ø© Ù„Ø¨Ù†Ø§Ù†ÙŠØ©"
             , "42 Ù„ÙŠØ±Ø§Øª Ù„Ø¨Ù†Ø§Ù†ÙŠØ©"
             ]
  , examples (simple EGP 42)
             [ "42 EGP"
             , "42 Ø¬Ù†ÙŠÙ‡ Ù…ØµØ±ÙŠ"
             , "42 Ø¬Ù†ÙŠÙ‡Ø§Øª Ù…ØµØ±ÙŠÙ‡"
             , "42 Ø¬.Ù…"
             , "42 Ø¬.Ù…."
             ]
  , examples (simple QAR 42)
             [ "42 QAR"
             , "42 Ø±ÙŠØ§Ù„ Ù‚Ø·Ø±ÙŠ"
             , "42 Ø±ÙŠØ§Ù„Ø§Øª Ù‚Ø·Ø±ÙŠØ©"
             ]
  , examples (simple SAR 42)
             [ "42 SAR"
             , "42 Ø±ÙŠØ§Ù„ Ø³Ø¹ÙˆØ¯ÙŠ"
             ]
  , examples (between Dollar (10, 20))
             [ "Ù…Ù† 10 Ø§Ù„Ù‰ 20 Ø¯ÙˆÙ„Ø§Ø±"
             , "Ø¨ØØ¯ÙˆØ¯ 10-20 Ø¯ÙˆÙ„Ø§Ø±"
             , "Ù…Ø§ Ø¨ÙŠÙ† Ø¹Ø´Ø±Ø© ÙˆØ¹Ø´Ø±ÙˆÙ† Ø¯ÙˆÙ„Ø§Ø±"
             , "Ù…Ù† Ø¹Ø´Ø±Ø© Ù„Ø¹Ø´Ø±ÙŠÙ† Ø¯ÙˆÙ„Ø§Ø±"
             , "ØÙˆØ§Ù„ÙŠ 10$-20$"
             , "10-20 $"
             , "10-20 Ø¯ÙˆÙ„Ø§Ø±"
             ]
  , examples (under EUR 7)
             [ "ØªØØª Ø³Ø¨Ø¹Ø© Ø§ÙˆØ±Ùˆ"
             , "Ø§Ù‚Ù„ Ù…Ù† Ø³Ø¨Ø¹Ø© ÙŠÙˆØ±Ùˆ"
             , "Ø§Ù‚Ù„ Ù…Ù† 7 ÙŠÙˆØ±Ùˆ"
             ]
  , examples (above Dollar 3.42)
             [ "Ø§ÙƒØ«Ø± Ù…Ù† Ø«Ù„Ø§Ø«Ø© Ø¯ÙˆÙ„Ø§Ø± Ùˆ42 Ø³ÙŠÙ†Øª"
             , "3.42$ Ø¹Ù„Ù‰ Ø§Ù„Ø§Ù‚Ù„"
             ]
  , examples (simple JOD 5)
             [ "5 Ø¯ÙŠÙ†Ø§Ø± Ø§Ø±Ø¯Ù†ÙŠ"
             , "5 Ø¯Ù†Ø§Ù†ÙŠØ± Ø£Ø±Ø¯Ù†ÙŠØ©"
             ]
  , examples (simple ILS 5)
             [ "5 Ø´ÙŠÙ‚Ù„"
             , "5 Ø´ÙˆØ§Ù‚Ù„"
             , "Ø®Ù…Ø³Ø© Ø´ÙŠÙƒÙ„"
             ]
  ]


-- 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.AmountOfMoney.CA.Corpus
  ( corpus
  ) where

import Data.String
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Locale
import Duckling.Resolve
import Duckling.Testing.Types

corpus :: Corpus
corpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)

allExamples :: [Example]
allExamples = concat
  [ examples (simple Dollar 10)
             [ "$10"
             , "10$"
             , "deu dolars"
             , "deu dÃ²lars"
             ]
  , examples (simple Dollar 10000)
             [ "$10.000"
             , "10K$"
             , "$10k"
             ]
  , examples (simple USD 1.23)
             [ "USD1,23"
             ]
  , examples (simple EUR 20)
             [ "20â‚¬"
             , "20 euros"
             , "20 Euro"
             , "20 Euros"
             , "EUR 20"
             , "vint euros"
             ]
  , examples (simple EUR 29.99)
             [ "EUR29,99"
             , "29,99 euros"
             , "29,99 â‚¬"
             , "29,99â‚¬"
             ]
  , examples (simple Pound 9)
             [ "Â£9"
             , "nou lliures"
             , "9 lliures"
             ]
  ,examples (simple Pound 1)
             [ "Â£1"
             , "una lliura"
             , "1 lliura"
             ]
  , examples (simple GBP 3.01)
             [ "GBP3,01"
             , "GBP 3,01"
             , "3 gbp 1 cÃ¨ntims"
             , "3 gbp i 1 cÃ¨ntims"
             ]
  , examples (simple PTS 15)
             [ "15 Pt"
             , "15pta"
             , "15Ptas"
             ]
  , examples (between Dollar (10, 20))
             [ "entre 10 i 20 dÃ²lars"
             , "des de $10 fins a $20"
             , "10$ - 20 dolars"
             , "10 - 20 $"
             ]
  , examples (under Dollar 10)
             [ "menys de 10 dolars"
             , "no mÃ©s de 10$"
             ]
  , examples (above Dollar 10)
             [ "no menys de 10 dÃ²lars"
             , "mÃ©s de 10$"
             ]
  ]


-- 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 LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.AmountOfMoney.CA.Rules
  ( rules
  ) where

import Data.Maybe
import Data.String
import Prelude

import Duckling.AmountOfMoney.Helpers
import Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))
import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers (isNatural, isPositive)
import Duckling.Numeral.Types (NumeralData (..))
import Duckling.Types
import qualified Duckling.AmountOfMoney.Types as TAmountOfMoney
import qualified Duckling.Numeral.Types as TNumeral

ruleUnitAmount :: Rule
ruleUnitAmount = Rule
  { name = "<unit> <amount>"
  , pattern =
    [ Predicate isCurrencyOnly
    , Predicate isPositive
    ]
  , prod = \case
      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:
       Token Numeral NumeralData{TNumeral.value = v}:
       _) -> Just $ Token AmountOfMoney $ withValue v $ currencyOnly c
      _ -> Nothing
  }

ruleDollar :: Rule
ruleDollar = Rule
  { name = "dollar"
  , pattern =
    [ regex "d(Ã²|o|Ã³)lar(s)?"
    ]
  , prod = \_ -> Just $ Token AmountOfMoney $ currencyOnly Dollar
  }

ruleCent :: Rule
ruleCent = Rule
  { name = "cent"
  , pattern =
    [ regex "c(e|Ã¨)ntims?"
    ]
  , prod = \_ -> Just $ Token AmountOfMoney $ currencyOnly Cent
  }

rulePounds :: Rule
rulePounds = Rule
  { name = "Â£"
  , pattern =
    [ regex "(lliure|lliura)s?"
    ]
  , prod = \_ -> Just $ Token AmountOfMoney $ currencyOnly Pound
  }

ruleIntersectAndNumeral :: Rule
ruleIntersectAndNumeral = Rule
  { name = "intersect (and number)"
  , pattern =
    [ Predicate isWithoutCents
    , regex "i"
    , Predicate isNatural
    ]
  , prod = \case
      (Token AmountOfMoney fd:
       _:
       Token Numeral NumeralData{TNumeral.value = c}:
       _) -> Just $ Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersectXCents :: Rule
ruleIntersectXCents = Rule
  { name = "intersect (X cents)"
  , pattern =
    [ Predicate isWithoutCents
    , Predicate isCents
    ]
  , prod = \case
      (Token AmountOfMoney fd:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:
       _) -> Just $ Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersectAndXCents :: Rule
ruleIntersectAndXCents = Rule
  { name = "intersect (and X cents)"
  , pattern =
    [ Predicate isWithoutCents
    , regex "i"
    , Predicate isCents
    ]
  , prod = \case
      (Token AmountOfMoney fd:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:
       _) -> Just $ Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersect :: Rule
ruleIntersect = Rule
  { name = "intersect"
  , pattern =
    [ Predicate isWithoutCents
    , Predicate isNatural
    ]
  , prod = \case
      (Token AmountOfMoney fd:
       Token Numeral NumeralData{TNumeral.value = c}:
       _) -> Just $ Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral = Rule
  { name = "between|from <numeral> to|and <amount-of-money>"
  , pattern =
    [ regex "des de|des d'|entre"
    , Predicate isPositive
    , regex "fins a|i"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (_:
       Token Numeral NumeralData{TNumeral.value = from}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c}:
       _) | from < to ->
        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalBetween :: Rule
ruleIntervalBetween = Rule
  { name = "between|from <amount-of-money> to|and <amount-of-money>"
  , pattern =
    [ regex "des de|des d'|entre"
    , Predicate isSimpleAmountOfMoney
    , regex "fins a|i"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,
                                             TAmountOfMoney.currency = c1}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c2}:
       _) | from < to && c1 == c2 ->
        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1
      _ -> Nothing
  }

ruleIntervalNumeralDash :: Rule
ruleIntervalNumeralDash = Rule
  { name = "<numeral> - <amount-of-money>"
  , pattern =
    [ Predicate isNatural
    , regex "-"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (Token Numeral NumeralData{TNumeral.value = from}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c}:
       _) | from < to->
         Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalDash :: Rule
ruleIntervalDash = Rule
  { name = "<amount-of-money> - <amount-of-money>"
  , pattern =
    [ Predicate isSimpleAmountOfMoney
    , regex "-"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,
                                             TAmountOfMoney.currency = c1}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c2}:
       _) | from < to && c1 == c2 ->
        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1
      _ -> Nothing
  }

ruleIntervalMax :: Rule
ruleIntervalMax = Rule
  { name = "less/no more than <amount-of-money>"
  , pattern =
    [ regex "menys de|no m(e|Ã©)s de|no m(e|Ã©)s d'|menys d'"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c}:
       _) -> Just $ Token AmountOfMoney $ withMax to $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalMin :: Rule
ruleIntervalMin = Rule
  { name = "no less/more than <amount-of-money>"
  , pattern =
    [ regex "m(e|Ã©)s de|no menys de|m(e|Ã©)s d'|no menys d'"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                                             TAmountOfMoney.currency = c}:
       _) -> Just $ Token AmountOfMoney $ withMin to $ currencyOnly c
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleUnitAmount
  , ruleCent
  , ruleDollar
  , ruleIntersect
  , ruleIntersectAndNumeral
  , ruleIntersectAndXCents
  , ruleIntersectXCents
  , rulePounds
  , ruleIntervalBetweenNumeral
  , ruleIntervalBetween
  , ruleIntervalNumeralDash
  , ruleIntervalDash
  , ruleIntervalMax
  , ruleIntervalMin
  ]


-- 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.AmountOfMoney.EN.Corpus
  ( corpus
  , negativeCorpus
  , latentCorpus
  ) where

import Data.String
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Resolve (Options(..))
import Duckling.Testing.Types

negativeCorpus :: NegativeCorpus
negativeCorpus = (testContext, testOptions, examples)
  where
    examples =
      [ "exactly dollars"
      ]

corpus :: Corpus
corpus = (testContext, testOptions, allExamples)

latentCorpus :: Corpus
latentCorpus = (testContext, testOptions {withLatent = True}, xs)
  where
    xs = concat
      [ examples (simple Unnamed 5)
                 [ "five"
                 , "5"
                 , "about 5"
                 ]
      , examples (simple Unnamed 7.2)
                 [ "7.2"
                 , "7.20000"
                 ]
      ]

allExamples :: [Example]
allExamples = concat
  [ examples (simple Dollar 1)
             [ "$1"
             , "one dollar"
             , "a dollar"
             ]
  , examples (simple Dollar 10)
             [ "$10"
             , "$ 10"
             , "10$"
             , "10 dollars"
             , "ten dollars"
             ]
  , examples (simple Cent 10)
             [ "10 cent"
             , "ten pennies"
             , "ten cents"
             , "10 c"
             , "10Â¢"
             ]
  , examples (simple Dollar 1e4)
             [ "$10K"
             , "10k$"
             , "$10,000"
             ]
  , examples (simple USD 3.14)
             [ "USD3.14"
             , "3.14US$"
             , "US$ 3.14"
             , "US$3 and fourteen"
             ]
  , examples (simple EUR 20)
             [ "20\x20ac"
             , "20 euros"
             , "20 Euro"
             , "20 Euros"
             , "EUR 20"
             , "EUR 20.0"
             , "20â‚¬"
             , "20 â‚¬ur"
             ]
  , examples (simple Pound 10)
             [ "\x00a3\&10"
             , "ten pounds"
             ]
  , examples (simple INR 20)
             [ "Rs. 20"
             , "Rs 20"
             , "20 Rupees"
             , "20Rs"
             , "Rs20"
             ]
  , examples (simple INR 20.43)
             [ "20 Rupees 43"
             , "twenty rupees 43"
             ]
  , examples (simple Dollar 20.43)
             [ "$20 and 43c"
             , "$20 43"
             , "20 dollar 43c"
             , "20 dollars 43 cents"
             , "twenty dollar 43 cents"
             , "20 dollar 43"
             , "twenty dollar and 43"
             ]
  , examples (simple GBP 3.01)
             [ "GBP3.01"
             , "GBP 3.01"
             , "3 GBP 1 pence"
             , "3 GBP and one"
             ]
  , examples (simple CAD 3.03)
             [ "CAD3.03"
             , "CAD 3.03"
             , "3 CAD 3 cents"
             ]
  , examples (simple CHF 3.04)
             [ "CHF3.04"
             , "CHF 3.04"
             , "3 CHF 4 cents"
             ]
  , examples (simple CNY 3)
             [ "CNY3"
             , "CNY 3"
             , "3 CNY"
             , "3 yuan"
             ]
  , examples (simple Unnamed 42)
             [ "42 bucks"
             , "around 42 bucks"
             , "exactly 42 bucks"
             ]
  , examples (simple KWD 42)
             [ "42 KWD"
             , "42 kuwaiti Dinar"
             ]
  , examples (simple LBP 42)
             [ "42 LBP"
             , "42 Lebanese Pounds"
             ]
  , examples (simple EGP 42)
             [ "42 EGP"
             , "42 egyptianpound"
             , "42 LE"
             , "42 L.E"
             , "42 l.e."
             , "42 le"
             , "42 geneh"
             , "42 genihat masriya"
             ]
  , examples (simple QAR 42)
             [ "42 QAR"
             , "42 qatari riyals"
             ]
  , examples (simple SAR 42)
             [ "42 SAR"
             , "42 Saudiriyal"
             ]
  , examples (simple BGN 42)
             [ "42 BGN"
             ]
  , examples (simple MYR 42)
             [ "42 MYR"
             , "42 RM"
             , "RM 42"
             , "MYR 42"
             , "42MYR"
             , "42RM"
             , "RM42"
             , "MYR42"
             , "ringgit 42"
             , "42 ringgit"
             , "42 malaysia ringgit"
             , "malaysia ringgit 42"
             , "42 malaysian ringgit"
             , "malaysian ringgit 42"
             , "42 malaysia ringgits"
             , "malaysia ringgits 42"
             , "42 malaysian ringgits"
             , "malaysian ringgits 42"
             ]
  , examples (simple MYR 20.43)
             [ "20 ringgit and 43c"
             , "20 ringgit and 43 sen"
             , "twenty ringgit 43 sens"
             , "20 ringgit 43"
             , "twenty ringgit and 43"
             ]
  , examples (simple Dinar 10)
             [ "10 dinars"
             ]
  , examples (simple ILS 10)
             [ "ten shekels"
             , "10 ILS"
             ]
  , examples (simple Riyal 10)
             [ "ten riyals"
             , "10 riyals"
             ]
  , examples (simple Rial 10)
             [ "ten rials"
             , "10 rials"
             ]
  , examples (between Dollar (10, 20))
             [ "between 10 and 20 dollars"
             , "from 10 dollars to 20 dollars"
             , "around 10-20 dollars"
             , "between 10 dollars and 20 dollars"
             , "from 10 to 20 dollars"
             , "about $10-$20"
             , "10-20 dollars"
             ]
  , examples (between Dollar (1.1, 1.3))
             [ "between 1.1 and 1.3 dollars"
             , "from 1 point 1 and one point three dollars"
             ]
  , examples (under EUR 7)
             [ "under seven euros"
             , "less than 7 EUR"
             , "lower than 7â‚¬"
             , "no more than 7 euros"
             , "at most 7â‚¬"
             ]
  , examples (above Dollar 1.42)
             [ "more than 1 dollar and forty-two cents"
             , "at least $1.42"
             , "over 1.42 dollars"
             , "above a dollar and 42 cents"
             , "no less than $1.42"
             ]
   , examples (simple INR 5e5)
             [ "5 lakh rupees"
             , "five lakhs rupees"
             ]
   , examples (between INR (7, 9e5))
             [ "7-9 lakh rupees"
             ]
   , examples (simple INR 4e7)
             [ "four crore rupees"
             , "4 crores rupees"
             ]
   , examples (simple MNT 10)
             [ "ten tugriks"
             , "10 Tugrik"
             , "10MNT"
             ]
   , examples (simple USD 4.7e9)
             [ "US$4.7 billion"
             , "a US$4.7 billion"
             , "a US$ 4.7 billion"
             ]
  , examples (simple UAH 3.04)
             [ "UAH3.04"
             , "UAH 3.04"
             , "3 UAH 4 kopiykas"
             ]
  ]


-- 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 LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.AmountOfMoney.EN.Rules
  ( rules
  ) where

import Data.Maybe
import Data.String
import Prelude
import qualified Data.Text as Text

import Duckling.AmountOfMoney.Helpers
import Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))
import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers (isNatural, isPositive)
import Duckling.Numeral.Types (NumeralData (..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.AmountOfMoney.Types as TAmountOfMoney
import qualified Duckling.Numeral.Types as TNumeral

ruleUnitAmount :: Rule
ruleUnitAmount = Rule
  { name = "<unit> <amount>"
  , pattern =
    [ Predicate isCurrencyOnly
    , Predicate isPositive
    ]
  , prod = \case
      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:
       Token Numeral NumeralData{TNumeral.value = v}:
       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c
      _ -> Nothing
  }

rulePounds :: Rule
rulePounds = Rule
  { name = "Â£"
  , pattern =
    [ regex "pounds?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly Pound
  }

ruleOtherPounds :: Rule
ruleOtherPounds = Rule
  { name = "other pounds"
  , pattern =
    [ regex "(egyptian|lebanese) ?pounds?"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of
        "egyptian" -> Just . Token AmountOfMoney $ currencyOnly EGP
        "lebanese" -> Just . Token AmountOfMoney $ currencyOnly LBP
        _          -> Nothing
      _ -> Nothing
  }

ruleEgpAbrreviation :: Rule
ruleEgpAbrreviation = Rule
  { name = "livre Ã©gyptienne"
  , pattern =
    [ regex "[lL].?[eE].?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly EGP
  }

ruleEgpArabizi :: Rule
ruleEgpArabizi = Rule
  { name = "geneh"
  , pattern =
    [ regex "[Gg][eiy]*n[eiy]*h(at)?( m[aiey]?sr[eiy]+a?)?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly EGP
  }

ruleRiyals :: Rule
ruleRiyals = Rule
  { name = "riyals"
  , pattern =
    [ regex "(qatari|saudi) ?riyals?"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of
        "qatari" -> Just . Token AmountOfMoney $ currencyOnly QAR
        "saudi"  -> Just . Token AmountOfMoney $ currencyOnly SAR
        _        -> Nothing
      _ -> Nothing
  }

ruleDinars :: Rule
ruleDinars = Rule
  { name = "dinars"
  , pattern =
    [ regex "(kuwaiti) ?dinars?"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of
        "kuwaiti" -> Just . Token AmountOfMoney $ currencyOnly KWD
        _         -> Nothing
      _ -> Nothing
  }

ruleDirham :: Rule
ruleDirham = Rule
  { name = "dirham"
  , pattern =
    [ regex "dirhams?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly AED
  }

ruleRinggit :: Rule
ruleRinggit = Rule
  { name = "ringgit"
  , pattern =
    [ regex "(malaysian? )?ringgits?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly MYR
  }

ruleHryvnia :: Rule
ruleHryvnia = Rule
  { name = "hryvnia"
  , pattern =
      [ regex "hryvnia" -- TODO: complete
      ]
  , prod = \_ -> Just $ Token AmountOfMoney $ currencyOnly UAH
  }

ruleCent :: Rule
ruleCent = Rule
  { name = "cent"
  , pattern =
    [ regex "cents?|penn(y|ies)|pence|sens?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly Cent
  }

ruleKopiyka :: Rule
ruleKopiyka = Rule
  { name = "kopiyka"
  , pattern =
    [ regex "kopiy(ok|kas?)"
    ]
  , prod = \_ -> Just $ Token AmountOfMoney $ currencyOnly Cent
  }

ruleBucks :: Rule
ruleBucks = Rule
  { name = "bucks"
  , pattern =
    [ regex "bucks?"
    ]
  , prod = \_ -> Just . Token AmountOfMoney $ currencyOnly Unnamed
  }

ruleACurrency :: Rule
ruleACurrency = Rule
  { name = "a <currency>"
  , pattern =
    [ regex "an?"
    , Predicate isCurrencyOnly
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token AmountOfMoney fd:
       _) -> Just . Token AmountOfMoney $ fd {TAmountOfMoney.value = Just 1}
      _ -> Nothing
  }

ruleAbsorbA :: Rule
ruleAbsorbA = Rule
  { name = "a <amount-of-money>"
  , pattern =
    [ regex "an?"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \case
      (_:Token AmountOfMoney fd:_) -> Just $ Token AmountOfMoney fd
      _ -> Nothing
  }

ruleADollarCoin :: Rule
ruleADollarCoin = Rule
  { name = "a <dollar coin>"
  , pattern =
    [ regex "an?"
    , Predicate isDollarCoin
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token AmountOfMoney fd:
       _) -> Just . Token AmountOfMoney $ fd
      _ -> Nothing
  }

ruleNumDollarCoins :: Rule
ruleNumDollarCoins = Rule
  { name = "X <dollar coins>"
  , pattern =
    [ Predicate isNatural
    , Predicate isDollarCoin
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = c}:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just d,
                                             TAmountOfMoney.currency = cur}:
       _) -> Just . Token AmountOfMoney $ withValue (c * d) $ currencyOnly cur
      _ -> Nothing
  }

ruleIntersectAndXCents :: Rule
ruleIntersectAndXCents = Rule
  { name = "intersect (and X cents)"
  , pattern =
    [ Predicate isWithoutCents
    , regex "and"
    , Predicate isCents
    ]
  , prod = \tokens -> case tokens of
      (Token AmountOfMoney fd:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:
       _) -> Just . Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersect :: Rule
ruleIntersect = Rule
  { name = "intersect"
  , pattern =
    [ Predicate isWithoutCents
    , Predicate isNatural
    ]
  , prod = \tokens -> case tokens of
      (Token AmountOfMoney fd:
       Token Numeral NumeralData{TNumeral.value = c}:
       _) -> Just . Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersectAndNumeral :: Rule
ruleIntersectAndNumeral = Rule
  { name = "intersect (and number)"
  , pattern =
    [ Predicate isWithoutCents
    , regex "and"
    , Predicate isNatural
    ]
  , prod = \tokens -> case tokens of
      (Token AmountOfMoney fd:
       _:
       Token Numeral NumeralData{TNumeral.value = c}:
       _) -> Just . Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

ruleIntersectXCents :: Rule
ruleIntersectXCents = Rule
  { name = "intersect (X cents)"
  , pattern =
    [ Predicate isWithoutCents
    , Predicate isCents
    ]
  , prod = \tokens -> case tokens of
      (Token AmountOfMoney fd:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:
       _) -> Just . Token AmountOfMoney $ withCents c fd
      _ -> Nothing
  }

rulePrecision :: Rule
rulePrecision = Rule
  { name = "about|exactly <amount-of-money>"
  , pattern =
    [ regex "exactly|precisely|about|approx(\\.|imately)?|close to|near( to)?|around|almost"
    , Predicate isMoneyWithValue
    ]
  , prod = \tokens -> case tokens of
      (_:token:_) -> Just token
      _ -> Nothing
  }

ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral = Rule
  { name = "between|from <numeral> to|and <amount-of-money>"
  , pattern =
    [ regex "between|from"
    , Predicate isPositive
    , regex "to|and"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token Numeral NumeralData{TNumeral.value = from}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c}:
       _) | from < to ->
        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalBetween :: Rule
ruleIntervalBetween = Rule
  { name = "between|from <amount-of-money> to|and <amount-of-money>"
  , pattern =
    [ regex "between|from"
    , Predicate isSimpleAmountOfMoney
    , regex "to|and"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,
                  TAmountOfMoney.currency = c1}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c2}:
       _) | from < to && c1 == c2 ->
        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1
      _ -> Nothing
  }

ruleIntervalNumeralDash :: Rule
ruleIntervalNumeralDash = Rule
  { name = "<numeral> - <amount-of-money>"
  , pattern =
    [ Predicate isNatural
    , regex "-"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (Token Numeral NumeralData{TNumeral.value = from}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c}:
       _) | from < to->
         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalDash :: Rule
ruleIntervalDash = Rule
  { name = "<amount-of-money> - <amount-of-money>"
  , pattern =
    [ Predicate isSimpleAmountOfMoney
    , regex "-"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,
                  TAmountOfMoney.currency = c1}:
       _:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c2}:
       _) | from < to && c1 == c2 ->
        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1
      _ -> Nothing
  }

ruleIntervalMax :: Rule
ruleIntervalMax = Rule
  { name = "under/less/lower/no more than <amount-of-money>"
  , pattern =
    [ regex "under|at most|(less|lower|not? more) than"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c}:
       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c
      _ -> Nothing
  }

ruleIntervalMin :: Rule
ruleIntervalMin = Rule
  { name = "over/above/at least/more than <amount-of-money>"
  , pattern =
    [ regex "over|above|at least|(more|not? less) than"
    , Predicate isSimpleAmountOfMoney
    ]
  , prod = \tokens -> case tokens of
      (_:
       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,
                  TAmountOfMoney.currency = c}:
       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleUnitAmount
  , ruleACurrency
  , ruleAbsorbA
  , ruleBucks
  , ruleCent
  , ruleADollarCoin
  , ruleNumDollarCoins
  , ruleDinars
  , ruleDirham
  , ruleHryvnia
  , ruleIntersect
  , ruleIntersectAndNumeral
  , ruleIntersectAndXCents
  , ruleIntersectXCents
  , ruleIntervalBetweenNumeral
  , ruleIntervalBetween
  , ruleIntervalMax
  , ruleIntervalMin
  , ruleIntervalNumeralDash
  , ruleIntervalDash
  , ruleKopiyka
  , ruleOtherPounds
  , ruleEgpAbrreviation
  , ruleEgpArabizi
  , rulePounds
  , rulePrecision
  , ruleRinggit
  , ruleRiyals
  ]


-- 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.AmountOfMoney.EN.AU.Corpus
  ( allExamples
  , negativeExamples
  ) where

import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Testing.Types

allExamples :: [Example]
allExamples = concat
  [ examples (simple AUD 1000)
             [ "a grand"
             , "1 grand"
             ]
  , examples (simple AUD 10000)
             [ "10 grand"
             , "two hundred thousand nickels"
             ]
  , examples (simple AUD 1)
             [ "four quarters"
             , "ten dimes"
             , "twenty nickels"
             ]
  , examples (simple AUD 0.1)
             [ "dime"
             , "a dime"
             , "two nickels"
             ]
  , examples (simple AUD 0.25)
             [ "quarter"
             , "a quarter"
             , "five nickels"
             ]
  , examples (simple AUD 0.05)
             [ "nickel"
             , "a nickel"
             ]
  ]

negativeExamples :: [Text]
negativeExamples =
  [ "grand"
  ]


-- 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 LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.AmountOfMoney.EN.AU.Rules
  ( rules
  ) where

import Data.HashMap.Strict (HashMap)
import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Helpers
import Duckling.AmountOfMoney.Types (Currency(..))
import Duckling.Numeral.Helpers (isPositive)
import Duckling.Regex.Types
import Duckling.Types

import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import qualified Duckling.AmountOfMoney.Helpers as Helpers
import qualified Duckling.Numeral.Types as TNumeral

ruleAGrand :: Rule
ruleAGrand = Rule
  { name = "a grand"
  , pattern =
    [ regex "a grand"
    ]
  , prod = \_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly AUD
  }

ruleGrand :: Rule
ruleGrand = Rule
  { name = "<amount> grand"
  , pattern =
    [ Predicate isPositive
    , regex "grand"
    ]
  , prod = \case
      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)
        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly AUD
      _ -> Nothing
  }

ruleDollarCoin :: Rule
ruleDollarCoin = Rule
  { name = "dollar coin"
  , pattern =
    [ regex "(nickel|dime|quarter)s?"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> do
        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins
        Just . Token AmountOfMoney . withValue c $ currencyOnly AUD
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleAGrand
  , ruleGrand
  , ruleDollarCoin
  ]


-- 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.AmountOfMoney.EN.BZ.Corpus
  ( allExamples
  , negativeExamples
  ) where

import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Testing.Types

allExamples :: [Example]
allExamples = concat
  [ examples (simple Dollar 1000)
             [ "a grand"
             , "1 grand"
             ]
  , examples (simple Dollar 10000)
             [ "10 grand"
             , "two hundred thousand nickels"
             ]
  , examples (simple Dollar 1)
             [ "four quarters"
             , "ten dimes"
             , "twenty nickels"
             ]
  , examples (simple Dollar 0.1)
             [ "dime"
             , "a dime"
             , "two nickels"
             ]
  , examples (simple Dollar 0.25)
             [ "quarter"
             , "a quarter"
             , "five nickels"
             ]
  , examples (simple Dollar 0.05)
             [ "nickel"
             , "a nickel"
             ]
  ]

negativeExamples :: [Text]
negativeExamples =
  [ "grand"
  ]


-- 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 LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.AmountOfMoney.EN.BZ.Rules
  ( rules
  ) where

import Data.HashMap.Strict (HashMap)
import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Helpers
import Duckling.AmountOfMoney.Types (Currency(..))
import Duckling.Numeral.Helpers (isPositive)
import Duckling.Regex.Types
import Duckling.Types

import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import qualified Duckling.AmountOfMoney.Helpers as Helpers
import qualified Duckling.Numeral.Types as TNumeral

ruleAGrand :: Rule
ruleAGrand = Rule
  { name = "a grand"
  , pattern =
    [ regex "a grand"
    ]
  , prod = \_ -> Just . Token AmountOfMoney . withValue 1000
                 $ currencyOnly Dollar
  }

ruleGrand :: Rule
ruleGrand = Rule
  { name = "<amount> grand"
  , pattern =
    [ Predicate isPositive
    , regex "grand"
    ]
  , prod = \case
      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)
        -> Just . Token AmountOfMoney . withValue (1000 * v)
           $ currencyOnly Dollar
      _ -> Nothing
  }

ruleDollarCoin :: Rule
ruleDollarCoin = Rule
  { name = "dollar coin"
  , pattern =
    [ regex "(nickel|dime|quarter)s?"
    ]
  , prod = \tokens -> case tokens of
      (Token RegexMatch (GroupMatch (match:_)):_) -> do
        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins
        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar
      _ -> Nothing
  }

rules :: [Rule]
rules =
  [ ruleAGrand
  , ruleGrand
  , ruleDollarCoin
  ]


-- 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.AmountOfMoney.EN.CA.Corpus
  ( allExamples
  , negativeExamples
  ) where

import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Types
import Duckling.Testing.Types

allExamples :: [Example]
allExamples = concat
  [ examples (simple CAD 1000)
             [ "a grand"
             , "1 grand"
             ]
  , examples (simple CAD 10000)
             [ "10 grand"
             , "two hundred thousand nickels"
             ]
  , examples (simple CAD 1)
             [ "four quarters"
             , "ten dimes"
             , "twenty nickels"
             ]
  , examples (simple CAD 0.1)
             [ "dime"
             , "a dime"
             , "two nickels"
             ]
  , examples (simple CAD 0.25)
             [ "quarter"
             , "a quarter"
             , "five nickels"
             ]
  , examples (simple CAD 0.05)
             [ "nickel"
             , "a nickel"
             ]
  ]

negativeExamples :: [Text]
negativeExamples =
  [ "grand"
  ]