Support custom dimensions

Summary:
Support custom dimensions

Had to move the definition of `Dimension` from `Duckling.Dimensions.Types` to `Duckling.Types` to avoid cyclic imports between these two modules.

A sample custom dimension is in `exe/CustomDimensionExample.hs`.

Limitations of custom dimensions:

- All rules for a custom dimension must be in the same module with the definition of the custom dimension. Otherwise there will be cyclic imports, because the definition of the dimension and the rules refer to each other.
- The custom dimension must be specified when using `parse`, since there's no way to get all the existing custom dimensions.

Reviewed By: patapizza

Differential Revision: D7630360

fbshipit-source-id: 30e12dcb33611f5692c4f5949de377bf61b75e1e

Duckling/AmountOfMoney/BG/Rules.hs

@@ -17,14 +17,12 @@ module Duckling.AmountOfMoney.BG.Rules
 import Data.Maybe
 import Data.String
 import Prelude
-import qualified Data.Text as Text
 
 import Duckling.AmountOfMoney.Helpers
 import Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))
 import Duckling.Dimensions.Types
 import Duckling.Numeral.Helpers (isNatural, isPositive)
 import Duckling.Numeral.Types (NumeralData (..))
-import Duckling.Regex.Types
 import Duckling.Types
 import qualified Duckling.AmountOfMoney.Types as TAmountOfMoney
 import qualified Duckling.Numeral.Types as TNumeral

Duckling/Api.hs

@@ -21,7 +21,6 @@ import Data.HashMap.Strict (HashMap)
 import Data.HashSet (HashSet)
 import Data.Text (Text)
 import Prelude
-import TextShow
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.HashSet as HashSet
 import qualified Data.Text as Text

Duckling/Core.hs

@@ -37,7 +37,6 @@ module Duckling.Core
   ) where
 
 import Data.HashMap.Strict (HashMap)
-import Data.Maybe
 import Data.Text (Text)
 import Data.Time
 import Data.Time.LocalTime.TimeZone.Series

Duckling/Dimensions.hs

@@ -19,6 +19,8 @@ import Prelude
 import qualified Data.HashSet as HashSet
 
 import Duckling.Dimensions.Types
+import Duckling.Locale
+import Duckling.Types
 import qualified Duckling.Dimensions.Common as CommonDimensions
 import qualified Duckling.Dimensions.AR as ARDimensions
 import qualified Duckling.Dimensions.BG as BGDimensions
@@ -54,7 +56,6 @@ import qualified Duckling.Dimensions.TR as TRDimensions
 import qualified Duckling.Dimensions.UK as UKDimensions
 import qualified Duckling.Dimensions.VI as VIDimensions
 import qualified Duckling.Dimensions.ZH as ZHDimensions
-import Duckling.Locale
 
 allDimensions :: Lang -> [Some Dimension]
 allDimensions lang = CommonDimensions.allDimensions ++ langDimensions lang
@@ -82,6 +83,7 @@ dependents (This Time) =
 dependents (This TimeGrain) = HashSet.empty
 dependents (This Url) = HashSet.empty
 dependents (This Volume) = HashSet.singleton (This Numeral)
+dependents (This (CustomDimension dim)) = dimDependents dim
 
 langDimensions :: Lang -> [Some Dimension]
 langDimensions AR = ARDimensions.allDimensions

Duckling/Dimensions/Types.hs

@@ -6,12 +6,8 @@
 -- of patent rights can be found in the PATENTS file in the same directory.
 
 
-
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NoRebindableSyntax #-}
-{-# LANGUAGE TypeOperators #-}
 
 
 module Duckling.Dimensions.Types
@@ -22,99 +18,14 @@ module Duckling.Dimensions.Types
   , toName
   ) where
 
-import Data.GADT.Compare
-import Data.GADT.Show
-import Data.Hashable
-import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe
 import Data.Some
 import Data.Text (Text)
--- Intentionally limit use of Typeable to avoid casting or typeOf usage
-import Data.Typeable ((:~:)(..))
-import TextShow (TextShow(..))
-import qualified TextShow as TS
 import Prelude
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Text as Text
 
-import Duckling.AmountOfMoney.Types (AmountOfMoneyData)
-import Duckling.Distance.Types (DistanceData)
-import Duckling.Duration.Types (DurationData)
-import Duckling.Email.Types (EmailData)
-import Duckling.Numeral.Types (NumeralData)
-import Duckling.Ordinal.Types (OrdinalData)
-import Duckling.PhoneNumber.Types (PhoneNumberData)
-import Duckling.Quantity.Types (QuantityData)
-import Duckling.Regex.Types (GroupMatch)
-import Duckling.Temperature.Types (TemperatureData)
-import Duckling.Time.Types (TimeData)
-import Duckling.TimeGrain.Types (Grain)
-import Duckling.Url.Types (UrlData)
-import Duckling.Volume.Types (VolumeData)
-
--- -----------------------------------------------------------------
--- Dimension
-
--- | GADT for differentiating between dimensions
--- Each dimension should have its own constructor and provide the data structure
--- for its parsed data
-data Dimension a where
-  RegexMatch :: Dimension GroupMatch
-  AmountOfMoney :: Dimension AmountOfMoneyData
-  Distance :: Dimension DistanceData
-  Duration :: Dimension DurationData
-  Email :: Dimension EmailData
-  Numeral :: Dimension NumeralData
-  Ordinal :: Dimension OrdinalData
-  PhoneNumber :: Dimension PhoneNumberData
-  Quantity :: Dimension QuantityData
-  Temperature :: Dimension TemperatureData
-  Time :: Dimension TimeData
-  TimeGrain :: Dimension Grain
-  Url :: Dimension UrlData
-  Volume :: Dimension VolumeData
-
--- Show
-instance Show (Dimension a) where
-  show RegexMatch = "RegexMatch"
-  show Distance = "Distance"
-  show Duration = "Duration"
-  show Email = "Email"
-  show AmountOfMoney = "AmountOfMoney"
-  show Numeral = "Numeral"
-  show Ordinal = "Ordinal"
-  show PhoneNumber = "PhoneNumber"
-  show Quantity = "Quantity"
-  show Temperature = "Temperature"
-  show Time = "Time"
-  show TimeGrain = "TimeGrain"
-  show Url = "Url"
-  show Volume = "Volume"
-instance GShow Dimension where gshowsPrec = showsPrec
-
--- TextShow
-instance TextShow (Dimension a) where
-  showb d = TS.fromString $ show d
-instance TextShow (Some Dimension) where
-  showb (This d) = showb d
-
--- Hashable
-instance Hashable (Some Dimension) where
-  hashWithSalt s (This a) = hashWithSalt s a
-instance Hashable (Dimension a) where
-  hashWithSalt s RegexMatch  = hashWithSalt s (0::Int)
-  hashWithSalt s Distance    = hashWithSalt s (1::Int)
-  hashWithSalt s Duration    = hashWithSalt s (2::Int)
-  hashWithSalt s Email       = hashWithSalt s (3::Int)
-  hashWithSalt s AmountOfMoney     = hashWithSalt s (4::Int)
-  hashWithSalt s Numeral     = hashWithSalt s (5::Int)
-  hashWithSalt s Ordinal     = hashWithSalt s (6::Int)
-  hashWithSalt s PhoneNumber = hashWithSalt s (7::Int)
-  hashWithSalt s Quantity    = hashWithSalt s (8::Int)
-  hashWithSalt s Temperature = hashWithSalt s (9::Int)
-  hashWithSalt s Time        = hashWithSalt s (10::Int)
-  hashWithSalt s TimeGrain   = hashWithSalt s (11::Int)
-  hashWithSalt s Url         = hashWithSalt s (12::Int)
-  hashWithSalt s Volume      = hashWithSalt s (13::Int)
-
+import Duckling.Types
 
 toName :: Dimension a -> Text
 toName RegexMatch = "regex"
@@ -131,6 +42,7 @@ toName Time = "time"
 toName TimeGrain = "time-grain"
 toName Url = "url"
 toName Volume = "volume"
+toName (CustomDimension dim) = Text.pack (show dim)
 
 fromName :: Text -> Maybe (Some Dimension)
 fromName name = HashMap.lookup name m
@@ -149,33 +61,3 @@ fromName name = HashMap.lookup name m
       , ("url", This Url)
       , ("volume", This Volume)
       ]
-
-instance GEq Dimension where
-  geq RegexMatch RegexMatch = Just Refl
-  geq RegexMatch _ = Nothing
-  geq Distance Distance = Just Refl
-  geq Distance _ = Nothing
-  geq Duration Duration = Just Refl
-  geq Duration _ = Nothing
-  geq Email Email = Just Refl
-  geq Email _ = Nothing
-  geq AmountOfMoney AmountOfMoney = Just Refl
-  geq AmountOfMoney _ = Nothing
-  geq Numeral Numeral = Just Refl
-  geq Numeral _ = Nothing
-  geq Ordinal Ordinal = Just Refl
-  geq Ordinal _ = Nothing
-  geq PhoneNumber PhoneNumber = Just Refl
-  geq PhoneNumber _ = Nothing
-  geq Quantity Quantity = Just Refl
-  geq Quantity _ = Nothing
-  geq Temperature Temperature = Just Refl
-  geq Temperature _ = Nothing
-  geq Time Time = Just Refl
-  geq Time _ = Nothing
-  geq TimeGrain TimeGrain = Just Refl
-  geq TimeGrain _ = Nothing
-  geq Url Url = Just Refl
-  geq Url _ = Nothing
-  geq Volume Volume = Just Refl
-  geq Volume _ = Nothing

Duckling/Numeral/BG/Rules.hs

@@ -16,7 +16,6 @@ module Duckling.Numeral.BG.Rules
 
 import Data.HashMap.Strict (HashMap)
 import Data.Maybe
-import Data.String
 import Data.Text (Text)
 import Prelude
 import qualified Data.HashMap.Strict as HashMap

Duckling/Ordinal/AR/Rules.hs

@@ -15,7 +15,6 @@ module Duckling.Ordinal.AR.Rules
   ) where
 
 import Data.HashMap.Strict (HashMap)
-import Data.String
 import Data.Text (Text)
 import Prelude
 import qualified Data.Text as Text

Duckling/Ordinal/BG/Rules.hs

@@ -15,7 +15,6 @@ module Duckling.Ordinal.BG.Rules
   ) where
 
 import Data.HashMap.Strict (HashMap)
-import Data.String
 import Data.Text (Text)
 import Prelude
 import qualified Data.HashMap.Strict as HashMap

Duckling/Rules/AR.hs

@@ -32,6 +32,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -49,3 +50,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules AR dim

Duckling/Rules/BG.hs

@@ -29,6 +29,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -46,3 +47,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules BG dim

Duckling/Rules/CS.hs

@@ -25,6 +25,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -42,3 +43,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules CS dim

Duckling/Rules/Common.hs

@@ -40,3 +40,4 @@ rules (This Time) = []
 rules (This TimeGrain) = []
 rules (This Url) = Url.rules
 rules (This Volume) = Volume.rules
+rules (This (CustomDimension dim)) = dimRules dim

Duckling/Rules/DA.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules DA dim

Duckling/Rules/DE.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules DE dim

Duckling/Rules/EL.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules EL dim

Duckling/Rules/EN.hs

@@ -61,7 +61,8 @@ localeRules PH (This Time) = TimePH.rules
 localeRules TT (This Time) = TimeTT.rules
 localeRules US (This Time) = TimeUS.rules
 localeRules ZA (This Time) = TimeZA.rules
-localeRules _ _            = []
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
+localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
 langRules (This AmountOfMoney) = AmountOfMoney.rules
@@ -78,3 +79,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules EN dim

Duckling/Rules/ES.hs

@@ -31,6 +31,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -48,3 +49,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules ES dim

Duckling/Rules/ET.hs

@@ -25,6 +25,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -42,3 +43,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules ET dim

Duckling/Rules/FR.hs

@@ -34,6 +34,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -51,3 +52,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules FR dim

Duckling/Rules/GA.hs

@@ -32,6 +32,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -49,3 +50,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules GA dim

Duckling/Rules/HE.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules HE dim

Duckling/Rules/HI.hs

@@ -24,6 +24,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -41,3 +42,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules HI dim

Duckling/Rules/HR.hs

@@ -34,6 +34,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -51,3 +52,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules HR dim

Duckling/Rules/HU.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules HU dim

Duckling/Rules/ID.hs

@@ -26,6 +26,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -43,3 +44,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules ID dim

Duckling/Rules/IT.hs

@@ -31,6 +31,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -48,3 +49,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules IT dim

Duckling/Rules/JA.hs

@@ -27,6 +27,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -44,3 +45,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules JA dim

Duckling/Rules/KA.hs

@@ -24,6 +24,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -41,3 +42,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules KA dim

Duckling/Rules/KO.hs

@@ -33,6 +33,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -50,3 +51,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules KO dim

Duckling/Rules/MY.hs

@@ -24,6 +24,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -41,3 +42,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules MY dim

Duckling/Rules/NB.hs

@@ -29,6 +29,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -46,3 +47,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules NB dim

Duckling/Rules/NE.hs

@@ -23,6 +23,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -40,3 +41,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules NE dim

Duckling/Rules/NL.hs

@@ -31,6 +31,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -48,3 +49,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules NL dim

Duckling/Rules/PL.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules PL dim

Duckling/Rules/PT.hs

@@ -33,6 +33,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -50,3 +51,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules PT dim

Duckling/Rules/RO.hs

@@ -33,6 +33,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -50,3 +51,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules RO dim

Duckling/Rules/RU.hs

@@ -31,6 +31,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -48,3 +49,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules RU dim

Duckling/Rules/SV.hs

@@ -30,6 +30,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -47,3 +48,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules SV dim

Duckling/Rules/TA.hs

@@ -23,6 +23,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -40,3 +41,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules TA dim

Duckling/Rules/TR.hs

@@ -30,6 +30,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -47,3 +48,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = Volume.rules
+langRules (This (CustomDimension dim)) = dimLangRules TR dim

Duckling/Rules/UK.hs

@@ -25,6 +25,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -42,3 +43,4 @@ langRules (This Time) = []
 langRules (This TimeGrain) = []
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules UK dim

Duckling/Rules/VI.hs

@@ -28,6 +28,7 @@ defaultRules :: Some Dimension -> [Rule]
 defaultRules = langRules
 
 localeRules :: Region -> Some Dimension -> [Rule]
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
 localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
@@ -45,3 +46,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules VI dim

Duckling/Rules/ZH.hs

@@ -38,7 +38,8 @@ localeRules CN (This Time) = TimeCN.rules
 localeRules HK (This Time) = TimeHK.rules
 localeRules MO (This Time) = TimeMO.rules
 localeRules TW (This Time) = TimeTW.rules
-localeRules _ _            = []
+localeRules region (This (CustomDimension dim)) = dimLocaleRules region dim
+localeRules _ _ = []
 
 langRules :: Some Dimension -> [Rule]
 langRules (This AmountOfMoney) = AmountOfMoney.rules
@@ -55,3 +56,4 @@ langRules (This Time) = Time.rules
 langRules (This TimeGrain) = TimeGrain.rules
 langRules (This Url) = []
 langRules (This Volume) = []
+langRules (This (CustomDimension dim)) = dimLangRules ZH dim

Duckling/Time/AR/Rules.hs

@@ -17,7 +17,7 @@ module Duckling.Time.AR.Rules
 import Data.Maybe
 import Data.Text (Text)
 import Prelude
-import Data.HashMap.Strict ( HashMap)
+import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as Text
 
@@ -25,7 +25,6 @@ import Duckling.Dimensions.Types
 import Duckling.Duration.Helpers (duration)
 import Duckling.Numeral.Helpers (parseInt)
 import Duckling.Numeral.Types (NumeralData (..))
-import Duckling.Ordinal.Types (OrdinalData (..))
 import Duckling.Regex.Types
 import Duckling.Time.Helpers
 import Duckling.Time.Types (TimeData (..))

Duckling/Time/Types.hs

@@ -16,7 +16,6 @@
 
 module Duckling.Time.Types where
 
-import Control.Applicative ((<|>))
 import Control.Arrow ((***))
 import Control.DeepSeq
 import Control.Monad (join)

Duckling/Types.hs

@@ -6,34 +6,57 @@
 -- of patent rights can be found in the PATENTS file in the same directory.
 
 
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NoRebindableSyntax #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Duckling.Types where
 
 import Control.DeepSeq
 import Data.Aeson
 import Data.GADT.Compare
+import Data.GADT.Show
 import Data.Hashable
+import Data.HashSet (HashSet)
 import Data.Maybe
-import Data.String
+import Data.Some
 import Data.Text (Text)
-import Data.Typeable ((:~:)(Refl), Typeable)
+import Data.Typeable ((:~:)(Refl), eqT, Typeable)
 import GHC.Generics
 import Prelude
+import TextShow (TextShow(..))
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Text.Encoding as Text
 import qualified Text.Regex.Base as R
 import qualified Text.Regex.PCRE as PCRE
+import qualified TextShow as TS
 
-import Duckling.Dimensions.Types
+import Duckling.AmountOfMoney.Types (AmountOfMoneyData)
+import Duckling.Distance.Types (DistanceData)
+import Duckling.Duration.Types (DurationData)
+import Duckling.Email.Types (EmailData)
+import Duckling.Locale
+import Duckling.Numeral.Types (NumeralData)
+import Duckling.Ordinal.Types (OrdinalData)
+import Duckling.PhoneNumber.Types (PhoneNumberData)
+import Duckling.Quantity.Types (QuantityData)
+import Duckling.Regex.Types (GroupMatch)
 import Duckling.Resolve
+import Duckling.Temperature.Types (TemperatureData)
+import Duckling.Time.Types (TimeData)
+import Duckling.TimeGrain.Types (Grain)
+import Duckling.Url.Types (UrlData)
+import Duckling.Volume.Types (VolumeData)
 
 -- -----------------------------------------------------------------
 -- Token
@@ -53,6 +76,115 @@ instance Hashable Token where
 instance NFData Token where
   rnf (Token _ v) = rnf v
 
+
+-- -----------------------------------------------------------------
+-- Dimension
+
+class (Show a, Typeable a) => CustomDimension a where
+  type DimensionData a
+  dimRules :: a -> [Rule]
+  dimLangRules :: Lang -> a -> [Rule]
+  dimLocaleRules :: Region -> a -> [Rule]
+  dimDependents :: a -> HashSet (Some Dimension)
+
+-- | GADT for differentiating between dimensions
+-- Each dimension should have its own constructor and provide the data structure
+-- for its parsed data
+data Dimension a where
+  RegexMatch :: Dimension GroupMatch
+  AmountOfMoney :: Dimension AmountOfMoneyData
+  Distance :: Dimension DistanceData
+  Duration :: Dimension DurationData
+  Email :: Dimension EmailData
+  Numeral :: Dimension NumeralData
+  Ordinal :: Dimension OrdinalData
+  PhoneNumber :: Dimension PhoneNumberData
+  Quantity :: Dimension QuantityData
+  Temperature :: Dimension TemperatureData
+  Time :: Dimension TimeData
+  TimeGrain :: Dimension Grain
+  Url :: Dimension UrlData
+  Volume :: Dimension VolumeData
+  CustomDimension :: CustomDimension a => a -> Dimension (DimensionData a)
+
+-- Show
+instance Show (Dimension a) where
+  show RegexMatch = "RegexMatch"
+  show Distance = "Distance"
+  show Duration = "Duration"
+  show Email = "Email"
+  show AmountOfMoney = "AmountOfMoney"
+  show Numeral = "Numeral"
+  show Ordinal = "Ordinal"
+  show PhoneNumber = "PhoneNumber"
+  show Quantity = "Quantity"
+  show Temperature = "Temperature"
+  show Time = "Time"
+  show TimeGrain = "TimeGrain"
+  show Url = "Url"
+  show Volume = "Volume"
+  show (CustomDimension dim) = show dim
+instance GShow Dimension where gshowsPrec = showsPrec
+
+-- TextShow
+instance TextShow (Dimension a) where
+  showb d = TS.fromString $ show d
+instance TextShow (Some Dimension) where
+  showb (This d) = showb d
+
+-- Hashable
+instance Hashable (Some Dimension) where
+  hashWithSalt s (This a) = hashWithSalt s a
+instance Hashable (Dimension a) where
+  hashWithSalt s RegexMatch          = hashWithSalt s (0::Int)
+  hashWithSalt s Distance            = hashWithSalt s (1::Int)
+  hashWithSalt s Duration            = hashWithSalt s (2::Int)
+  hashWithSalt s Email               = hashWithSalt s (3::Int)
+  hashWithSalt s AmountOfMoney       = hashWithSalt s (4::Int)
+  hashWithSalt s Numeral             = hashWithSalt s (5::Int)
+  hashWithSalt s Ordinal             = hashWithSalt s (6::Int)
+  hashWithSalt s PhoneNumber         = hashWithSalt s (7::Int)
+  hashWithSalt s Quantity            = hashWithSalt s (8::Int)
+  hashWithSalt s Temperature         = hashWithSalt s (9::Int)
+  hashWithSalt s Time                = hashWithSalt s (10::Int)
+  hashWithSalt s TimeGrain           = hashWithSalt s (11::Int)
+  hashWithSalt s Url                 = hashWithSalt s (12::Int)
+  hashWithSalt s Volume              = hashWithSalt s (13::Int)
+  hashWithSalt s (CustomDimension _) = hashWithSalt s (14::Int)
+
+instance GEq Dimension where
+  geq RegexMatch RegexMatch = Just Refl
+  geq RegexMatch _ = Nothing
+  geq Distance Distance = Just Refl
+  geq Distance _ = Nothing
+  geq Duration Duration = Just Refl
+  geq Duration _ = Nothing
+  geq Email Email = Just Refl
+  geq Email _ = Nothing
+  geq AmountOfMoney AmountOfMoney = Just Refl
+  geq AmountOfMoney _ = Nothing
+  geq Numeral Numeral = Just Refl
+  geq Numeral _ = Nothing
+  geq Ordinal Ordinal = Just Refl
+  geq Ordinal _ = Nothing
+  geq PhoneNumber PhoneNumber = Just Refl
+  geq PhoneNumber _ = Nothing
+  geq Quantity Quantity = Just Refl
+  geq Quantity _ = Nothing
+  geq Temperature Temperature = Just Refl
+  geq Temperature _ = Nothing
+  geq Time Time = Just Refl
+  geq Time _ = Nothing
+  geq TimeGrain TimeGrain = Just Refl
+  geq TimeGrain _ = Nothing
+  geq Url Url = Just Refl
+  geq Url _ = Nothing
+  geq Volume Volume = Just Refl
+  geq Volume _ = Nothing
+  geq (CustomDimension (_ :: a)) (CustomDimension (_ :: b))
+    | Just Refl <- eqT :: Maybe (a :~: b) = Just Refl
+  geq (CustomDimension _) _ = Nothing
+
 isDimension :: Dimension a -> Token -> Bool
 isDimension dim (Token dim' _) = isJust $ geq dim dim'
 

Duckling/Url/Helpers.hs

@@ -12,10 +12,8 @@ module Duckling.Url.Helpers
   ( url
   ) where
 
-import Data.String
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Prelude
 
 import qualified Duckling.Url.Types as TUrl
 import Duckling.Url.Types (UrlData(..))

Duckling/Url/Types.hs

@@ -19,7 +19,6 @@ import Control.DeepSeq
 import Data.Aeson
 import Data.Hashable
 import Data.Maybe
-import Data.Monoid
 import Data.Text (Text)
 import GHC.Generics
 import Prelude

duckling.cabal

@@ -924,6 +924,22 @@ executable duckling-example-exe
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings
 
+executable custom-dimension-example
+  main-is:             CustomDimensionExample.hs
+  hs-source-dirs:      exe
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       duckling
+                     , aeson
+                     , base
+                     , deepseq
+                     , dependent-sum
+                     , hashable
+                     , text
+                     , text-show
+                     , unordered-containers
+  default-language:    Haskell2010
+  default-extensions:  OverloadedStrings
+
 executable duckling-request-sample
   main-is:             DucklingRequestSample.hs
   hs-source-dirs:      exe

exe/CustomDimensionExample.hs

@@ -0,0 +1,82 @@
+-- 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 LambdaCase #-}
+{-# LANGUAGE NoRebindableSyntax #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main (main) where
+
+import Control.DeepSeq
+import Control.Monad
+import Data.Aeson
+import Data.Hashable
+import Data.Semigroup ((<>))
+import Data.Some
+import Data.Text (Text)
+import Data.Typeable
+import GHC.Generics
+import Prelude
+import qualified Data.HashSet as HashSet
+import qualified TextShow as TS
+
+import Duckling.Debug
+import Duckling.Locale
+import Duckling.Resolve (Resolve(..))
+import Duckling.Types
+
+data MyDimension = MyDimension deriving (Eq, Show, Typeable)
+
+instance CustomDimension MyDimension where
+  type DimensionData MyDimension = MyData
+  dimRules _ = [myRule]
+  dimLangRules _ _ = []
+  dimLocaleRules _ _ = []
+  dimDependents _ = HashSet.empty
+
+data MyData = MyData
+  { iField :: Int
+  , bField :: Bool
+  , tField :: Text
+  }
+  deriving (Eq, Generic, Hashable, Ord, Show, NFData)
+
+instance Resolve MyData where
+  type ResolvedValue MyData = MyValue
+  resolve _ _ MyData{..} = Just
+    ( MyValue $ TS.showt iField <> "," <> TS.showt bField <> "," <> tField
+    , False )
+
+newtype MyValue = MyValue { value :: Text }
+  deriving (Eq, Ord, Show)
+
+instance ToJSON MyValue where
+  toJSON (MyValue value) = object [ "value" .= value ]
+
+myRule :: Rule
+myRule = Rule
+  { name = "my dimension"
+  , pattern =
+    [ regex "my dimension"
+    ]
+  , prod = \case
+      (_:_) -> Just . Token (CustomDimension MyDimension) $ MyData
+                 { iField = 42
+                 , bField = True
+                 , tField = "hello world"
+                 }
+      _ -> Nothing
+  }
+
+main :: IO ()
+main = do
+  let en = makeLocale EN Nothing
+  debug en "input for my dimension" [This (CustomDimension MyDimension)] >>= print