content: -- 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.Aeson.KeyMap as K
  import qualified Data.Text as Text
  
  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 $ K.insert "type" (toJSON ("value" :: Text)) o
      _ -> Object K.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}
  