2017-03-08 21:33:55 +03:00
|
|
|
-- 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. An additional grant
|
|
|
|
-- of patent rights can be found in the PATENTS file in the same directory.
|
|
|
|
|
|
|
|
|
|
|
|
{-# LANGUAGE GADTs #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2017-03-16 23:42:15 +03:00
|
|
|
module Duckling.Numeral.Helpers
|
2017-03-08 21:33:55 +03:00
|
|
|
( decimalsToDouble
|
|
|
|
, double
|
|
|
|
, integer
|
|
|
|
, multiply
|
|
|
|
, numberBetween
|
|
|
|
, numberWith
|
|
|
|
, oneOf
|
|
|
|
, parseDouble
|
|
|
|
, parseInt
|
|
|
|
, withGrain
|
|
|
|
, withMultipliable
|
|
|
|
, parseDecimal,
|
|
|
|
) where
|
|
|
|
|
|
|
|
import qualified Data.Attoparsec.Text as Atto
|
|
|
|
import Data.Maybe
|
|
|
|
import Data.Text (Text)
|
|
|
|
import qualified Data.Text as Text
|
|
|
|
import Prelude
|
|
|
|
|
|
|
|
import Duckling.Dimensions.Types
|
2017-03-16 23:42:15 +03:00
|
|
|
import Duckling.Numeral.Types
|
|
|
|
import Duckling.Types hiding (value)
|
|
|
|
|
2017-03-08 21:33:55 +03:00
|
|
|
zeroT :: Text
|
|
|
|
zeroT = Text.singleton '0'
|
|
|
|
|
|
|
|
dot :: Text
|
|
|
|
dot = Text.singleton '.'
|
|
|
|
|
|
|
|
comma :: Text
|
|
|
|
comma = Text.singleton ','
|
|
|
|
|
|
|
|
parseInt :: Text -> Maybe Int
|
|
|
|
parseInt =
|
|
|
|
either (const Nothing) Just . Atto.parseOnly (Atto.signed Atto.decimal)
|
|
|
|
|
|
|
|
-- | Add leading 0 when leading . for double parsing to succeed
|
|
|
|
parseDouble :: Text -> Maybe Double
|
|
|
|
parseDouble s
|
|
|
|
| Text.head s == '.' = go $ Text.append zeroT s
|
|
|
|
| otherwise = go s
|
|
|
|
where go = either (const Nothing) Just . Atto.parseOnly Atto.double
|
|
|
|
|
|
|
|
-- | 77 -> .77
|
|
|
|
-- | Find the first power of ten larger that the actual number
|
|
|
|
-- | Use it to divide x
|
|
|
|
decimalsToDouble :: Double -> Double
|
|
|
|
decimalsToDouble x =
|
|
|
|
let xs = filter (\y -> x - y < 0)
|
|
|
|
. take 10
|
|
|
|
. iterate (*10) $ 1 in
|
|
|
|
case xs of
|
|
|
|
[] -> 0
|
|
|
|
(multiplier : _) -> x / multiplier
|
|
|
|
|
|
|
|
-- -----------------------------------------------------------------
|
|
|
|
-- Patterns
|
|
|
|
|
2017-03-16 23:42:15 +03:00
|
|
|
numberWith :: (NumeralData -> t) -> (t -> Bool) -> PatternItem
|
2017-03-08 21:33:55 +03:00
|
|
|
numberWith f pred = Predicate $ \x ->
|
|
|
|
case x of
|
2017-03-16 23:42:15 +03:00
|
|
|
(Token Numeral x@NumeralData{}) -> pred (f x)
|
2017-03-08 21:33:55 +03:00
|
|
|
_ -> False
|
|
|
|
|
|
|
|
numberBetween :: Double -> Double -> PatternItem
|
|
|
|
numberBetween low up = Predicate $ \x ->
|
|
|
|
case x of
|
2017-03-16 23:42:15 +03:00
|
|
|
(Token Numeral NumeralData {value = v, multipliable = False}) ->
|
2017-03-08 21:33:55 +03:00
|
|
|
low <= v && v < up
|
|
|
|
_ -> False
|
|
|
|
|
|
|
|
oneOf :: [Double] -> PatternItem
|
|
|
|
oneOf vs = Predicate $ \x ->
|
|
|
|
case x of
|
2017-03-16 23:42:15 +03:00
|
|
|
(Token Numeral NumeralData {value = v}) -> elem v vs
|
2017-03-08 21:33:55 +03:00
|
|
|
_ -> False
|
|
|
|
|
|
|
|
-- -----------------------------------------------------------------
|
|
|
|
-- Production
|
|
|
|
|
|
|
|
withMultipliable :: Token -> Maybe Token
|
2017-03-16 23:42:15 +03:00
|
|
|
withMultipliable (Token Numeral x@NumeralData{}) =
|
|
|
|
Just . Token Numeral $ x {multipliable = True}
|
2017-03-08 21:33:55 +03:00
|
|
|
withMultipliable _ = Nothing
|
|
|
|
|
|
|
|
withGrain :: Int -> Token -> Maybe Token
|
2017-03-16 23:42:15 +03:00
|
|
|
withGrain g (Token Numeral x@NumeralData{}) =
|
|
|
|
Just . Token Numeral $ x {grain = Just g}
|
2017-03-08 21:33:55 +03:00
|
|
|
withGrain _ _ = Nothing
|
|
|
|
|
|
|
|
double :: Double -> Maybe Token
|
2017-03-16 23:42:15 +03:00
|
|
|
double x = Just . Token Numeral $ NumeralData
|
|
|
|
{ value = x
|
|
|
|
, grain = Nothing
|
|
|
|
, multipliable = False
|
2017-03-08 21:33:55 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
integer :: Integer -> Maybe Token
|
|
|
|
integer = double . fromIntegral
|
|
|
|
|
|
|
|
multiply :: Token -> Token -> Maybe Token
|
|
|
|
multiply
|
2017-03-16 23:42:15 +03:00
|
|
|
(Token Numeral (NumeralData {value = v1}))
|
|
|
|
(Token Numeral (NumeralData {value = v2, grain = g})) = case g of
|
2017-03-08 21:33:55 +03:00
|
|
|
Nothing -> double $ v1 * v2
|
|
|
|
Just grain | v2 > v1 -> double (v1 * v2) >>= withGrain grain
|
|
|
|
| otherwise -> Nothing
|
|
|
|
multiply _ _ = Nothing
|
|
|
|
|
|
|
|
parseDecimal :: Bool -> Text -> Maybe Token
|
|
|
|
parseDecimal isDot match
|
|
|
|
| isDot = parseDouble match >>= double
|
|
|
|
| otherwise =
|
|
|
|
parseDouble (Text.replace comma dot match)
|
|
|
|
>>= double
|