-- 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.Numeral.Helpers
  ( decimalsToDouble
  , diffIntegerDigits
  , double
  , integer
  , multiply
  , isMultipliable
  , isNatural
  , isPositive
  , hasGrain
  , divide
  , notOkForAnyTime
  , numberBetween
  , numberWith
  , numeralMapEL
  , oneOf
  , parseDouble
  , parseInt
  , parseInteger
  , withGrain
  , withMultipliable
  , parseDecimal
  ) where

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

import Duckling.Dimensions.Types
import Duckling.Numeral.Types
import Duckling.Types hiding (Entity(value))

zeroT :: Text
zeroT :: Text
zeroT = Char -> Text
Text.singleton Char
'0'

dot :: Text
dot :: Text
dot = Char -> Text
Text.singleton Char
'.'

comma :: Text
comma :: Text
comma = Char -> Text
Text.singleton Char
','

parseInt :: Text -> Maybe Int
parseInt :: Text -> Maybe Int
parseInt = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Integer -> Maybe Int)
-> (Text -> Maybe Integer) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Integer
parseInteger

parseInteger :: Text -> Maybe Integer
parseInteger :: Text -> Maybe Integer
parseInteger =
  (String -> Maybe Integer)
-> (Integer -> Maybe Integer)
-> Either String Integer
-> Maybe Integer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Integer -> String -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Either String Integer -> Maybe Integer)
-> (Text -> Either String Integer) -> Text -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Integer -> Text -> Either String Integer
forall a. Parser a -> Text -> Either String a
Atto.parseOnly (Parser Integer -> Parser Integer
forall a. Num a => Parser a -> Parser a
Atto.signed Parser Integer
forall a. Integral a => Parser a
Atto.decimal)

-- | Add leading 0 when leading . for double parsing to succeed
parseDouble :: Text -> Maybe Double
parseDouble :: Text -> Maybe Double
parseDouble Text
s
  | Text -> Char
Text.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = Text -> Maybe Double
go (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Text.append Text
zeroT Text
s
  | Bool
otherwise = Text -> Maybe Double
go Text
s
  where go :: Text -> Maybe Double
go = (String -> Maybe Double)
-> (Double -> Maybe Double) -> Either String Double -> Maybe Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Double -> String -> Maybe Double
forall a b. a -> b -> a
const Maybe Double
forall a. Maybe a
Nothing) Double -> Maybe Double
forall a. a -> Maybe a
Just (Either String Double -> Maybe Double)
-> (Text -> Either String Double) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Double -> Text -> Either String Double
forall a. Parser a -> Text -> Either String a
Atto.parseOnly Parser Double
Atto.double

-- | 77 -> .77
-- | Find the first power of ten larger that the actual number
-- | Use it to divide x
decimalsToDouble :: Double -> Double
decimalsToDouble :: Double -> Double
decimalsToDouble Double
x =
  let xs :: [Double]
xs = (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Double
y -> Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0)
         ([Double] -> [Double])
-> (Double -> [Double]) -> Double -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
10
         ([Double] -> [Double])
-> (Double -> [Double]) -> Double -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
10) (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ Double
1 in
    case [Double]
xs of
      [] -> Double
0
      (Double
multiplier : [Double]
_) -> Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
multiplier

-- diffIntegerDigits a b = # of digits in a - # of digits in b
-- ignores the nondecimal components
diffIntegerDigits :: Double -> Double -> Int
diffIntegerDigits :: Double -> Double -> Int
diffIntegerDigits Double
a Double
b = Double -> Int
digitsOf Double
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Double -> Int
digitsOf Double
b
  where
    digitsOf :: Double -> Int
    digitsOf :: Double -> Int
digitsOf = Int -> Int
digitsOfInt (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Num a => a -> a
abs

    digitsOfInt :: Int -> Int
    digitsOfInt :: Int -> Int
digitsOfInt Int
0 = Int
0
    digitsOfInt Int
a = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
digitsOfInt (Int
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)

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

numberWith :: (NumeralData -> t) -> (t -> Bool) -> PatternItem
numberWith :: (NumeralData -> t) -> (t -> Bool) -> PatternItem
numberWith NumeralData -> t
f t -> Bool
pred = Predicate -> PatternItem
Predicate (Predicate -> PatternItem) -> Predicate -> PatternItem
forall a b. (a -> b) -> a -> b
$ \Token
x ->
  case Token
x of
    (Token Dimension a
Numeral x :: a
x@NumeralData{}) -> t -> Bool
pred (NumeralData -> t
f a
NumeralData
x)
    Token
_ -> Bool
False

numberBetween :: Double -> Double -> PatternItem
numberBetween :: Double -> Double -> PatternItem
numberBetween Double
low Double
up = Predicate -> PatternItem
Predicate (Predicate -> PatternItem) -> Predicate -> PatternItem
forall a b. (a -> b) -> a -> b
$ \Token
x ->
  case Token
x of
    (Token Dimension a
Numeral NumeralData {value = v, multipliable = False}) ->
      Double
low Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
v Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
up
    Token
_ -> Bool
False

isNatural :: Predicate
isNatural :: Predicate
isNatural (Token Dimension a
Numeral NumeralData {value = v}) =
  Double -> Bool
isInteger Double
v Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
isNatural Token
_ = Bool
False

isPositive :: Predicate
isPositive :: Predicate
isPositive (Token Dimension a
Numeral NumeralData{value = v}) = Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
isPositive Token
_ = Bool
False

isMultipliable :: Predicate
isMultipliable :: Predicate
isMultipliable (Token Dimension a
Numeral a
nd) = NumeralData -> Bool
multipliable a
NumeralData
nd
isMultipliable Token
_ = Bool
False

hasGrain :: Predicate
hasGrain :: Predicate
hasGrain (Token Dimension a
Numeral NumeralData {grain = Just g}) = Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
hasGrain Token
_ = Bool
False

oneOf :: [Double] -> PatternItem
oneOf :: [Double] -> PatternItem
oneOf [Double]
vs = Predicate -> PatternItem
Predicate (Predicate -> PatternItem) -> Predicate -> PatternItem
forall a b. (a -> b) -> a -> b
$ \Token
x ->
  case Token
x of
    (Token Dimension a
Numeral NumeralData {value = v}) -> Double -> [Double] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Double
v [Double]
vs
    Token
_ -> Bool
False

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

withMultipliable :: Token -> Maybe Token
withMultipliable :: Token -> Maybe Token
withMultipliable (Token Dimension a
Numeral x :: a
x@NumeralData{}) =
  Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (NumeralData -> Token) -> NumeralData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension NumeralData -> NumeralData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension NumeralData
Numeral (NumeralData -> Maybe Token) -> NumeralData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ a
NumeralData
x {multipliable :: Bool
multipliable = Bool
True}
withMultipliable Token
_ = Maybe Token
forall a. Maybe a
Nothing

withGrain :: Int -> Token -> Maybe Token
withGrain :: Int -> Token -> Maybe Token
withGrain Int
g (Token Dimension a
Numeral x :: a
x@NumeralData{}) =
  Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (NumeralData -> Token) -> NumeralData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension NumeralData -> NumeralData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension NumeralData
Numeral (NumeralData -> Maybe Token) -> NumeralData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ a
NumeralData
x {grain :: Maybe Int
grain = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
g}
withGrain Int
_ Token
_ = Maybe Token
forall a. Maybe a
Nothing

notOkForAnyTime :: Token -> Maybe Token
notOkForAnyTime :: Token -> Maybe Token
notOkForAnyTime (Token Dimension a
Numeral a
x) =
  Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (NumeralData -> Token) -> NumeralData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension NumeralData -> NumeralData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension NumeralData
Numeral (NumeralData -> Maybe Token) -> NumeralData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ a
NumeralData
x {okForAnyTime :: Bool
okForAnyTime = Bool
False}
notOkForAnyTime Token
_ = Maybe Token
forall a. Maybe a
Nothing

double :: Double -> Maybe Token
double :: Double -> Maybe Token
double Double
x = Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (NumeralData -> Token) -> NumeralData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension NumeralData -> NumeralData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension NumeralData
Numeral (NumeralData -> Maybe Token) -> NumeralData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ NumeralData :: Double -> Maybe Int -> Bool -> Bool -> NumeralData
NumeralData
  { value :: Double
value = Double
x
  , grain :: Maybe Int
grain = Maybe Int
forall a. Maybe a
Nothing
  , multipliable :: Bool
multipliable = Bool
False
  , okForAnyTime :: Bool
okForAnyTime = Bool
True
  }

integer :: Integer -> Maybe Token
integer :: Integer -> Maybe Token
integer = Double -> Maybe Token
double (Double -> Maybe Token)
-> (Integer -> Double) -> Integer -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

multiply :: Token -> Token -> Maybe Token
multiply :: Token -> Token -> Maybe Token
multiply
  (Token Dimension a
Numeral NumeralData{value = v1})
  (Token Dimension a
Numeral NumeralData{value = v2, grain = g}) = case Maybe Int
g of
  Maybe Int
Nothing -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v2
  Just Int
grain | Double
v2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
v1 -> Double -> Maybe Token
double (Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v2) Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
grain
             | Bool
otherwise -> Maybe Token
forall a. Maybe a
Nothing
multiply Token
_ Token
_ = Maybe Token
forall a. Maybe a
Nothing

divide :: Token -> Token -> Maybe Token
divide :: Token -> Token -> Maybe Token
divide
  (Token Dimension a
Numeral NumeralData{value = v1})
  (Token Dimension a
Numeral NumeralData{value = v2}) = case Double
v1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
v2 of
    Double
x | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x -> Maybe Token
forall a. Maybe a
Nothing
    Double
x -> Double -> Maybe Token
double Double
x
divide Token
_ Token
_ = Maybe Token
forall a. Maybe a
Nothing

parseDecimal :: Bool -> Text -> Maybe Token
parseDecimal :: Bool -> Text -> Maybe Token
parseDecimal Bool
isDot Text
match
  | Bool
isDot = Text -> Maybe Double
parseDouble Text
match Maybe Double -> (Double -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Maybe Token
double
  | Bool
otherwise =
    Text -> Maybe Double
parseDouble (Text -> Text -> Text -> Text
Text.replace Text
comma Text
dot Text
match)
    Maybe Double -> (Double -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Maybe Token
double

-- TODO: Single-word composition (#110)
numeralMapEL :: HashMap Text Int
numeralMapEL :: HashMap Text Int
numeralMapEL = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"δι"          , Int
2  )
  , ( Text
"δί"          , Int
2  )
  , ( Text
"τρι"         , Int
3  )
  , ( Text
"τρί"         , Int
3  )
  , ( Text
"τετρ"        , Int
4  )
  , ( Text
"πεντ"        , Int
5  )
  , ( Text
"πενθ"        , Int
5  )
  , ( Text
"εξ"          , Int
6  )
  , ( Text
"επτ"         , Int
7  )
  , ( Text
"εφτ"         , Int
7  )
  , ( Text
"οκτ"         , Int
8  )
  , ( Text
"οχτ"         , Int
8  )
  , ( Text
"εννι"        , Int
9  )
  , ( Text
"δεκ"         , Int
10 )
  , ( Text
"δεκαπεντ"    , Int
15 )
  , ( Text
"δεκαπενθ"    , Int
15 )
  , ( Text
"εικοσ"       , Int
20 )
  , ( Text
"εικοσιπεντ"  , Int
25 )
  , ( Text
"εικοσιπενθ"  , Int
25 )
  , ( Text
"τριαντ"      , Int
30 )
  , ( Text
"τριανταπεντ" , Int
35 )
  , ( Text
"τριανταπενθ" , Int
35 )
  , ( Text
"σαραντ"      , Int
40 )
  , ( Text
"σαρανταπεντ" , Int
45 )
  , ( Text
"σαρανταπενθ" , Int
45 )
  , ( Text
"πενηντ"      , Int
50 )
  , ( Text
"πενηνταπετν" , Int
55 )
  , ( Text
"πενηνταπετθ" , Int
55 )
  , ( Text
"εξηντ"       , Int
60 )
  , ( Text
"ενενηντ"     , Int
90 )
  -- The following are used as prefixes
  , ( Text
"μιά"         , Int
1  )
  , ( Text
"ενά"         , Int
1  )
  , ( Text
"δυό"         , Int
2  )
  , ( Text
"τρεισή"      , Int
3  )
  , ( Text
"τεσσερισή"   , Int
4  )
  , ( Text
"τεσσερσή"    , Int
4  )
  , ( Text
"πεντέ"       , Int
5  )
  , ( Text
"εξί"         , Int
6  )
  , ( Text
"επτά"        , Int
7  )
  , ( Text
"εφτά"        , Int
7  )
  , ( Text
"οκτώ"        , Int
8  )
  , ( Text
"οχτώ"        , Int
8  )
  , ( Text
"εννιά"       , Int
9  )
  , ( Text
"δεκά"        , Int
10 )
  , ( Text
"εντεκά"      , Int
11 )
  , ( Text
"δωδεκά"      , Int
12 )
  ]