-- 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 GADTs #-}
{-# LANGUAGE NoRebindableSyntax #-}


module Duckling.Dimensions.Types
  ( Seal(..)
  , Dimension(..)

  , fromName
  , toName
  ) where

import Data.Maybe
import Data.Text (Text)
import Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text

import Duckling.Types

toName :: Dimension a -> Text
toName :: Dimension a -> Text
toName Dimension a
RegexMatch = Text
"regex"
toName Dimension a
CreditCardNumber = Text
"credit-card-number"
toName Dimension a
Distance = Text
"distance"
toName Dimension a
Duration = Text
"duration"
toName Dimension a
Email = Text
"email"
toName Dimension a
AmountOfMoney = Text
"amount-of-money"
toName Dimension a
Numeral = Text
"number"
toName Dimension a
Ordinal = Text
"ordinal"
toName Dimension a
PhoneNumber = Text
"phone-number"
toName Dimension a
Quantity = Text
"quantity"
toName Dimension a
Temperature = Text
"temperature"
toName Dimension a
Time = Text
"time"
toName Dimension a
TimeGrain = Text
"time-grain"
toName Dimension a
Url = Text
"url"
toName Dimension a
Volume = Text
"volume"
toName (CustomDimension a
dim) = String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
dim)

fromName :: Text -> Maybe (Seal Dimension)
fromName :: Text -> Maybe (Seal Dimension)
fromName Text
name = Text -> HashMap Text (Seal Dimension) -> Maybe (Seal Dimension)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text (Seal Dimension)
m
  where
    m :: HashMap Text (Seal Dimension)
m = [(Text, Seal Dimension)] -> HashMap Text (Seal Dimension)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
      [ (Text
"amount-of-money", Dimension AmountOfMoneyData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension AmountOfMoneyData
AmountOfMoney)
      , (Text
"credit-card-number", Dimension CreditCardNumberData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension CreditCardNumberData
CreditCardNumber)
      , (Text
"distance", Dimension DistanceData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension DistanceData
Distance)
      , (Text
"duration", Dimension DurationData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension DurationData
Duration)
      , (Text
"email", Dimension EmailData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension EmailData
Email)
      , (Text
"number", Dimension NumeralData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension NumeralData
Numeral)
      , (Text
"ordinal", Dimension OrdinalData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension OrdinalData
Ordinal)
      , (Text
"phone-number", Dimension PhoneNumberData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension PhoneNumberData
PhoneNumber)
      , (Text
"quantity", Dimension QuantityData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension QuantityData
Quantity)
      , (Text
"temperature", Dimension TemperatureData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension TemperatureData
Temperature)
      , (Text
"time", Dimension TimeData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension TimeData
Time)
      , (Text
"time-grain", Dimension Grain -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension Grain
TimeGrain)
      , (Text
"url", Dimension UrlData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension UrlData
Url)
      , (Text
"volume", Dimension VolumeData -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension VolumeData
Volume)
      ]