mirror of
https://github.com/facebook/duckling.git
synced 2024-09-11 21:27:13 +03:00
16708d9572
Summary: Minor Volume.FR improvement: add "Centilitre" type. This is useful for recipe parsing. Pull Request resolved: https://github.com/facebook/duckling/pull/354 Reviewed By: patapizza Differential Revision: D26193246 Pulled By: chessai fbshipit-source-id: ddd551e062b8efeff1e786e30e35815c0c29a34c
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.
|
|
|
|
|
|
{-# 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
|
|
| Centilitre
|
|
| 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}
|