mirror of
https://github.com/facebook/duckling.git
synced 2024-11-28 08:34:46 +03:00
6a05e40a37
Summary: This diff implements volume intervals in Duckling. It follows the AmountofMoney and Quantity modules in doing so. I had to make one crucial choice here -- defining the core Volume data type -- and whether the attribute "Unit" was optional (i.e. "Maybe") or not. Like in Quantity and unlike in AmountOfMoney, I made it optional, so that latent volumes can be supported down the line in the codebase. I also wrote the codebase to be more modular, such that future developers only need to add regular expressions rather than functions for any language. For instance, developers can simply define a fraction (e.g. "eighth") at the start of the file, and new rules will be generated automatically; rather than requiring the developer to create an entirely new rule, as previously. The only (partial) exceptions were in the Arabic and Russian Rules files, where the language structure is more difficult and so I cannot fully implement this. Developers for those two languages may need to write new rules, as before. Reviewed By: patapizza Differential Revision: D9043117 fbshipit-source-id: f08de4f167596b5b32d12a79268b8ab92c099b22
120 lines
3.4 KiB
Haskell
120 lines
3.4 KiB
Haskell
-- 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 DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE NoRebindableSyntax #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Duckling.Volume.Types where
|
|
|
|
import Control.DeepSeq
|
|
import Data.Aeson
|
|
import Data.Hashable
|
|
import Data.Text (Text)
|
|
import GHC.Generics
|
|
import Prelude
|
|
import Duckling.Resolve (Resolve (..))
|
|
import qualified Data.Text as Text
|
|
import qualified Data.HashMap.Strict as H
|
|
|
|
data Unit
|
|
= Gallon
|
|
| Hectolitre
|
|
| Litre
|
|
| Millilitre
|
|
deriving (Eq, Generic, Hashable, Ord, Show, NFData)
|
|
|
|
instance ToJSON Unit where
|
|
toJSON = String . Text.toLower . Text.pack . show
|
|
|
|
data VolumeData = VolumeData
|
|
{ value :: Maybe Double
|
|
, unit :: Maybe Unit
|
|
, minValue :: Maybe Double
|
|
, maxValue :: Maybe Double
|
|
}
|
|
deriving (Eq, Generic, Hashable, Ord, Show, NFData)
|
|
|
|
instance Resolve VolumeData where
|
|
type ResolvedValue VolumeData = VolumeValue
|
|
resolve _ _ VolumeData {value = Just v, unit = Just u} =
|
|
Just (simple u v, False)
|
|
resolve _ _ VolumeData {value = Nothing, unit = Just u
|
|
, minValue = Just from, maxValue = Just to} =
|
|
Just (between u (from, to), False)
|
|
resolve _ _ VolumeData {value = Nothing, unit = Just u
|
|
, minValue = Just v, maxValue = Nothing} =
|
|
Just (above u v, False)
|
|
resolve _ _ VolumeData {value = Nothing, unit = Just u
|
|
, minValue = Nothing, maxValue = Just v} =
|
|
Just (under u v, False)
|
|
resolve _ _ _ = Nothing
|
|
|
|
data IntervalDirection = Above | Under
|
|
deriving (Eq, Generic, Hashable, Ord, Show, NFData)
|
|
|
|
data SingleValue = SingleValue
|
|
{ vUnit :: Unit
|
|
, vValue :: Double
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
instance ToJSON SingleValue where
|
|
toJSON SingleValue {vUnit, vValue} = object
|
|
[ "value" .= vValue
|
|
, "unit" .= vUnit
|
|
]
|
|
|
|
data VolumeValue
|
|
= SimpleValue SingleValue
|
|
| IntervalValue (SingleValue, SingleValue)
|
|
| OpenIntervalValue (SingleValue, IntervalDirection)
|
|
deriving (Show, Eq)
|
|
|
|
instance ToJSON VolumeValue 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 :: Unit -> Double -> VolumeValue
|
|
simple u v = SimpleValue $ single u v
|
|
|
|
between :: Unit -> (Double, Double) -> VolumeValue
|
|
between u (from,to) = IntervalValue (single u from, single u to)
|
|
|
|
above :: Unit -> Double -> VolumeValue
|
|
above = openInterval Above
|
|
|
|
under :: Unit -> Double -> VolumeValue
|
|
under = openInterval Under
|
|
|
|
openInterval :: IntervalDirection -> Unit -> Double -> VolumeValue
|
|
openInterval direction u v = OpenIntervalValue (single u v, direction)
|
|
|
|
single :: Unit -> Double -> SingleValue
|
|
single u v = SingleValue {vUnit = u, vValue = v}
|