-- 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 (Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq, (forall x. Unit -> Rep Unit x)
-> (forall x. Rep Unit x -> Unit) -> Generic Unit
forall x. Rep Unit x -> Unit
forall x. Unit -> Rep Unit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unit x -> Unit
$cfrom :: forall x. Unit -> Rep Unit x
Generic, Int -> Unit -> Int
Unit -> Int
(Int -> Unit -> Int) -> (Unit -> Int) -> Hashable Unit
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Unit -> Int
$chash :: Unit -> Int
hashWithSalt :: Int -> Unit -> Int
$chashWithSalt :: Int -> Unit -> Int
Hashable, Eq Unit
Eq Unit
-> (Unit -> Unit -> Ordering)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Unit)
-> (Unit -> Unit -> Unit)
-> Ord Unit
Unit -> Unit -> Bool
Unit -> Unit -> Ordering
Unit -> Unit -> Unit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unit -> Unit -> Unit
$cmin :: Unit -> Unit -> Unit
max :: Unit -> Unit -> Unit
$cmax :: Unit -> Unit -> Unit
>= :: Unit -> Unit -> Bool
$c>= :: Unit -> Unit -> Bool
> :: Unit -> Unit -> Bool
$c> :: Unit -> Unit -> Bool
<= :: Unit -> Unit -> Bool
$c<= :: Unit -> Unit -> Bool
< :: Unit -> Unit -> Bool
$c< :: Unit -> Unit -> Bool
compare :: Unit -> Unit -> Ordering
$ccompare :: Unit -> Unit -> Ordering
$cp1Ord :: Eq Unit
Ord, Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show, Unit -> ()
(Unit -> ()) -> NFData Unit
forall a. (a -> ()) -> NFData a
rnf :: Unit -> ()
$crnf :: Unit -> ()
NFData)

instance ToJSON Unit where
  toJSON :: Unit -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Unit -> Text) -> Unit -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (Unit -> Text) -> Unit -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Unit -> String) -> Unit -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> String
forall a. Show a => a -> String
show

data VolumeData = VolumeData
  { VolumeData -> Maybe Double
value :: Maybe Double
  , VolumeData -> Maybe Unit
unit :: Maybe Unit
  , VolumeData -> Maybe Double
minValue :: Maybe Double
  , VolumeData -> Maybe Double
maxValue :: Maybe Double
  }
  deriving (VolumeData -> VolumeData -> Bool
(VolumeData -> VolumeData -> Bool)
-> (VolumeData -> VolumeData -> Bool) -> Eq VolumeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolumeData -> VolumeData -> Bool
$c/= :: VolumeData -> VolumeData -> Bool
== :: VolumeData -> VolumeData -> Bool
$c== :: VolumeData -> VolumeData -> Bool
Eq, (forall x. VolumeData -> Rep VolumeData x)
-> (forall x. Rep VolumeData x -> VolumeData) -> Generic VolumeData
forall x. Rep VolumeData x -> VolumeData
forall x. VolumeData -> Rep VolumeData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VolumeData x -> VolumeData
$cfrom :: forall x. VolumeData -> Rep VolumeData x
Generic, Int -> VolumeData -> Int
VolumeData -> Int
(Int -> VolumeData -> Int)
-> (VolumeData -> Int) -> Hashable VolumeData
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: VolumeData -> Int
$chash :: VolumeData -> Int
hashWithSalt :: Int -> VolumeData -> Int
$chashWithSalt :: Int -> VolumeData -> Int
Hashable, Eq VolumeData
Eq VolumeData
-> (VolumeData -> VolumeData -> Ordering)
-> (VolumeData -> VolumeData -> Bool)
-> (VolumeData -> VolumeData -> Bool)
-> (VolumeData -> VolumeData -> Bool)
-> (VolumeData -> VolumeData -> Bool)
-> (VolumeData -> VolumeData -> VolumeData)
-> (VolumeData -> VolumeData -> VolumeData)
-> Ord VolumeData
VolumeData -> VolumeData -> Bool
VolumeData -> VolumeData -> Ordering
VolumeData -> VolumeData -> VolumeData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VolumeData -> VolumeData -> VolumeData
$cmin :: VolumeData -> VolumeData -> VolumeData
max :: VolumeData -> VolumeData -> VolumeData
$cmax :: VolumeData -> VolumeData -> VolumeData
>= :: VolumeData -> VolumeData -> Bool
$c>= :: VolumeData -> VolumeData -> Bool
> :: VolumeData -> VolumeData -> Bool
$c> :: VolumeData -> VolumeData -> Bool
<= :: VolumeData -> VolumeData -> Bool
$c<= :: VolumeData -> VolumeData -> Bool
< :: VolumeData -> VolumeData -> Bool
$c< :: VolumeData -> VolumeData -> Bool
compare :: VolumeData -> VolumeData -> Ordering
$ccompare :: VolumeData -> VolumeData -> Ordering
$cp1Ord :: Eq VolumeData
Ord, Int -> VolumeData -> ShowS
[VolumeData] -> ShowS
VolumeData -> String
(Int -> VolumeData -> ShowS)
-> (VolumeData -> String)
-> ([VolumeData] -> ShowS)
-> Show VolumeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolumeData] -> ShowS
$cshowList :: [VolumeData] -> ShowS
show :: VolumeData -> String
$cshow :: VolumeData -> String
showsPrec :: Int -> VolumeData -> ShowS
$cshowsPrec :: Int -> VolumeData -> ShowS
Show, VolumeData -> ()
(VolumeData -> ()) -> NFData VolumeData
forall a. (a -> ()) -> NFData a
rnf :: VolumeData -> ()
$crnf :: VolumeData -> ()
NFData)

instance Resolve VolumeData where
  type ResolvedValue VolumeData = VolumeValue
  resolve :: Context
-> Options -> VolumeData -> Maybe (ResolvedValue VolumeData, Bool)
resolve Context
_ Options
_ VolumeData {value :: VolumeData -> Maybe Double
value = Just Double
v, unit :: VolumeData -> Maybe Unit
unit = Just Unit
u} =
    (VolumeValue, Bool) -> Maybe (VolumeValue, Bool)
forall a. a -> Maybe a
Just (Unit -> Double -> VolumeValue
simple Unit
u Double
v, Bool
False)
  resolve Context
_ Options
_ VolumeData {value :: VolumeData -> Maybe Double
value = Maybe Double
Nothing, unit :: VolumeData -> Maybe Unit
unit = Just Unit
u
                         , minValue :: VolumeData -> Maybe Double
minValue = Just Double
from, maxValue :: VolumeData -> Maybe Double
maxValue = Just Double
to} =
    (VolumeValue, Bool) -> Maybe (VolumeValue, Bool)
forall a. a -> Maybe a
Just (Unit -> (Double, Double) -> VolumeValue
between Unit
u (Double
from, Double
to), Bool
False)
  resolve Context
_ Options
_ VolumeData {value :: VolumeData -> Maybe Double
value = Maybe Double
Nothing, unit :: VolumeData -> Maybe Unit
unit = Just Unit
u
                         , minValue :: VolumeData -> Maybe Double
minValue = Just Double
v, maxValue :: VolumeData -> Maybe Double
maxValue = Maybe Double
Nothing} =
    (VolumeValue, Bool) -> Maybe (VolumeValue, Bool)
forall a. a -> Maybe a
Just (Unit -> Double -> VolumeValue
above Unit
u Double
v, Bool
False)
  resolve Context
_ Options
_ VolumeData {value :: VolumeData -> Maybe Double
value = Maybe Double
Nothing, unit :: VolumeData -> Maybe Unit
unit = Just Unit
u
                         , minValue :: VolumeData -> Maybe Double
minValue = Maybe Double
Nothing, maxValue :: VolumeData -> Maybe Double
maxValue = Just Double
v} =
    (VolumeValue, Bool) -> Maybe (VolumeValue, Bool)
forall a. a -> Maybe a
Just (Unit -> Double -> VolumeValue
under Unit
u Double
v, Bool
False)
  resolve Context
_ Options
_ VolumeData
_ = Maybe (ResolvedValue VolumeData, Bool)
forall a. Maybe a
Nothing

data IntervalDirection = Above | Under
  deriving (IntervalDirection -> IntervalDirection -> Bool
(IntervalDirection -> IntervalDirection -> Bool)
-> (IntervalDirection -> IntervalDirection -> Bool)
-> Eq IntervalDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalDirection -> IntervalDirection -> Bool
$c/= :: IntervalDirection -> IntervalDirection -> Bool
== :: IntervalDirection -> IntervalDirection -> Bool
$c== :: IntervalDirection -> IntervalDirection -> Bool
Eq, (forall x. IntervalDirection -> Rep IntervalDirection x)
-> (forall x. Rep IntervalDirection x -> IntervalDirection)
-> Generic IntervalDirection
forall x. Rep IntervalDirection x -> IntervalDirection
forall x. IntervalDirection -> Rep IntervalDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IntervalDirection x -> IntervalDirection
$cfrom :: forall x. IntervalDirection -> Rep IntervalDirection x
Generic, Int -> IntervalDirection -> Int
IntervalDirection -> Int
(Int -> IntervalDirection -> Int)
-> (IntervalDirection -> Int) -> Hashable IntervalDirection
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: IntervalDirection -> Int
$chash :: IntervalDirection -> Int
hashWithSalt :: Int -> IntervalDirection -> Int
$chashWithSalt :: Int -> IntervalDirection -> Int
Hashable, Eq IntervalDirection
Eq IntervalDirection
-> (IntervalDirection -> IntervalDirection -> Ordering)
-> (IntervalDirection -> IntervalDirection -> Bool)
-> (IntervalDirection -> IntervalDirection -> Bool)
-> (IntervalDirection -> IntervalDirection -> Bool)
-> (IntervalDirection -> IntervalDirection -> Bool)
-> (IntervalDirection -> IntervalDirection -> IntervalDirection)
-> (IntervalDirection -> IntervalDirection -> IntervalDirection)
-> Ord IntervalDirection
IntervalDirection -> IntervalDirection -> Bool
IntervalDirection -> IntervalDirection -> Ordering
IntervalDirection -> IntervalDirection -> IntervalDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntervalDirection -> IntervalDirection -> IntervalDirection
$cmin :: IntervalDirection -> IntervalDirection -> IntervalDirection
max :: IntervalDirection -> IntervalDirection -> IntervalDirection
$cmax :: IntervalDirection -> IntervalDirection -> IntervalDirection
>= :: IntervalDirection -> IntervalDirection -> Bool
$c>= :: IntervalDirection -> IntervalDirection -> Bool
> :: IntervalDirection -> IntervalDirection -> Bool
$c> :: IntervalDirection -> IntervalDirection -> Bool
<= :: IntervalDirection -> IntervalDirection -> Bool
$c<= :: IntervalDirection -> IntervalDirection -> Bool
< :: IntervalDirection -> IntervalDirection -> Bool
$c< :: IntervalDirection -> IntervalDirection -> Bool
compare :: IntervalDirection -> IntervalDirection -> Ordering
$ccompare :: IntervalDirection -> IntervalDirection -> Ordering
$cp1Ord :: Eq IntervalDirection
Ord, Int -> IntervalDirection -> ShowS
[IntervalDirection] -> ShowS
IntervalDirection -> String
(Int -> IntervalDirection -> ShowS)
-> (IntervalDirection -> String)
-> ([IntervalDirection] -> ShowS)
-> Show IntervalDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntervalDirection] -> ShowS
$cshowList :: [IntervalDirection] -> ShowS
show :: IntervalDirection -> String
$cshow :: IntervalDirection -> String
showsPrec :: Int -> IntervalDirection -> ShowS
$cshowsPrec :: Int -> IntervalDirection -> ShowS
Show, IntervalDirection -> ()
(IntervalDirection -> ()) -> NFData IntervalDirection
forall a. (a -> ()) -> NFData a
rnf :: IntervalDirection -> ()
$crnf :: IntervalDirection -> ()
NFData)

data SingleValue = SingleValue
  { SingleValue -> Unit
vUnit :: Unit
  , SingleValue -> Double
vValue :: Double
  }
  deriving (SingleValue -> SingleValue -> Bool
(SingleValue -> SingleValue -> Bool)
-> (SingleValue -> SingleValue -> Bool) -> Eq SingleValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleValue -> SingleValue -> Bool
$c/= :: SingleValue -> SingleValue -> Bool
== :: SingleValue -> SingleValue -> Bool
$c== :: SingleValue -> SingleValue -> Bool
Eq, Int -> SingleValue -> ShowS
[SingleValue] -> ShowS
SingleValue -> String
(Int -> SingleValue -> ShowS)
-> (SingleValue -> String)
-> ([SingleValue] -> ShowS)
-> Show SingleValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingleValue] -> ShowS
$cshowList :: [SingleValue] -> ShowS
show :: SingleValue -> String
$cshow :: SingleValue -> String
showsPrec :: Int -> SingleValue -> ShowS
$cshowsPrec :: Int -> SingleValue -> ShowS
Show)

instance ToJSON SingleValue where
  toJSON :: SingleValue -> Value
toJSON SingleValue {Unit
vUnit :: Unit
vUnit :: SingleValue -> Unit
vUnit, Double
vValue :: Double
vValue :: SingleValue -> Double
vValue} = [Pair] -> Value
object
    [ Text
"value" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
vValue
    , Text
"unit"  Text -> Unit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Unit
vUnit
    ]

data VolumeValue
  = SimpleValue SingleValue
  | IntervalValue (SingleValue, SingleValue)
  | OpenIntervalValue (SingleValue, IntervalDirection)
  deriving (Int -> VolumeValue -> ShowS
[VolumeValue] -> ShowS
VolumeValue -> String
(Int -> VolumeValue -> ShowS)
-> (VolumeValue -> String)
-> ([VolumeValue] -> ShowS)
-> Show VolumeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolumeValue] -> ShowS
$cshowList :: [VolumeValue] -> ShowS
show :: VolumeValue -> String
$cshow :: VolumeValue -> String
showsPrec :: Int -> VolumeValue -> ShowS
$cshowsPrec :: Int -> VolumeValue -> ShowS
Show, VolumeValue -> VolumeValue -> Bool
(VolumeValue -> VolumeValue -> Bool)
-> (VolumeValue -> VolumeValue -> Bool) -> Eq VolumeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolumeValue -> VolumeValue -> Bool
$c/= :: VolumeValue -> VolumeValue -> Bool
== :: VolumeValue -> VolumeValue -> Bool
$c== :: VolumeValue -> VolumeValue -> Bool
Eq)

instance ToJSON VolumeValue where
  toJSON :: VolumeValue -> Value
toJSON (SimpleValue SingleValue
value) = case SingleValue -> Value
forall a. ToJSON a => a -> Value
toJSON SingleValue
value of
    Object Object
o -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
"type" (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"value" :: Text)) Object
o
    Value
_ -> Object -> Value
Object Object
forall k v. HashMap k v
H.empty
  toJSON (IntervalValue (SingleValue
from, SingleValue
to)) = [Pair] -> Value
object
    [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"interval" :: Text)
    , Text
"from" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SingleValue -> Value
forall a. ToJSON a => a -> Value
toJSON SingleValue
from
    , Text
"to" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SingleValue -> Value
forall a. ToJSON a => a -> Value
toJSON SingleValue
to
    ]
  toJSON (OpenIntervalValue (SingleValue
from, IntervalDirection
Above)) = [Pair] -> Value
object
    [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"interval" :: Text)
    , Text
"from" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SingleValue -> Value
forall a. ToJSON a => a -> Value
toJSON SingleValue
from
    ]
  toJSON (OpenIntervalValue (SingleValue
to, IntervalDirection
Under)) = [Pair] -> Value
object
    [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"interval" :: Text)
    , Text
"to" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SingleValue -> Value
forall a. ToJSON a => a -> Value
toJSON SingleValue
to
    ]

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

simple :: Unit -> Double -> VolumeValue
simple :: Unit -> Double -> VolumeValue
simple Unit
u Double
v = SingleValue -> VolumeValue
SimpleValue (SingleValue -> VolumeValue) -> SingleValue -> VolumeValue
forall a b. (a -> b) -> a -> b
$ Unit -> Double -> SingleValue
single Unit
u Double
v

between :: Unit -> (Double, Double) -> VolumeValue
between :: Unit -> (Double, Double) -> VolumeValue
between Unit
u (Double
from,Double
to) = (SingleValue, SingleValue) -> VolumeValue
IntervalValue (Unit -> Double -> SingleValue
single Unit
u Double
from, Unit -> Double -> SingleValue
single Unit
u Double
to)

above :: Unit -> Double -> VolumeValue
above :: Unit -> Double -> VolumeValue
above = IntervalDirection -> Unit -> Double -> VolumeValue
openInterval IntervalDirection
Above

under :: Unit -> Double -> VolumeValue
under :: Unit -> Double -> VolumeValue
under = IntervalDirection -> Unit -> Double -> VolumeValue
openInterval IntervalDirection
Under

openInterval :: IntervalDirection -> Unit -> Double -> VolumeValue
openInterval :: IntervalDirection -> Unit -> Double -> VolumeValue
openInterval IntervalDirection
direction Unit
u Double
v = (SingleValue, IntervalDirection) -> VolumeValue
OpenIntervalValue (Unit -> Double -> SingleValue
single Unit
u Double
v, IntervalDirection
direction)

single :: Unit -> Double -> SingleValue
single :: Unit -> Double -> SingleValue
single Unit
u Double
v = SingleValue :: Unit -> Double -> SingleValue
SingleValue {vUnit :: Unit
vUnit = Unit
u, vValue :: Double
vValue = Double
v}