Change value in Entity to typed value instead of JSON

Summary:
Modified `Entity` to use the new `ResolvedVal` data type. Other changes follow naturally. Related issues: https://github.com/facebook/duckling/issues/121 and https://github.com/facebook/duckling/issues/172

Now one can pattern match on the output value, for instance:

```
{-# LANGUAGE GADTs #-}

import Data.Text
import Duckling.Core
import Duckling.Testing.Types
import qualified Duckling.PhoneNumber.Types as PN

parsePhoneNumber :: Text -> Text
parsePhoneNumber input =
  case value entity of
    (RVal PhoneNumber (PN.PhoneNumberValue v)) -> v
    where
    (entity:_) = parse input testContext testOptions [This PhoneNumber]
```

Reviewed By: patapizza

Differential Revision: D7502020

fbshipit-source-id: 76ba7b315cfd0d2c61ff95c855b7c95efc0a401c

Duckling/Api.hs

@@ -6,9 +6,9 @@
 -- of patent rights can be found in the PATENTS file in the same directory.
 
 
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoRebindableSyntax #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NoRebindableSyntax #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Duckling.Api
   ( analyze

Duckling/Core.hs

@@ -20,9 +20,11 @@ module Duckling.Core
   , Options(..)
   , Range(..)
   , Region(..)
+  , ResolvedVal(..)
   , Some(..)
   , fromName
   , makeLocale
+  , toJText
   , toName
 
   -- Duckling API

Duckling/Engine.hs

@@ -219,12 +219,12 @@ parseString rules sentence = do
     [ rule | rule@Rule{pattern = (Predicate _ : _)} <- rules ]
 
 resolveNode :: Context -> Options -> Node -> Maybe ResolvedToken
-resolveNode context options n@Node{token = (Token _ dd), nodeRange = nodeRange}
+resolveNode context options n@Node{token = (Token dim dd), nodeRange = r}
   = do
   (val, latent) <- resolve context options dd
   Just Resolved
-    { range = nodeRange
+    { range = r
     , node = n
-    , jsonValue = toJSON val
+    , rval = RVal dim val
     , isLatent = latent
     }

Duckling/Resolve.hs

@@ -42,7 +42,10 @@ newtype Options = Options
   }
   deriving (Eq, Show)
 
-class ToJSON (ResolvedValue a) => Resolve a where
+class ( Eq (ResolvedValue a)
+      , Show (ResolvedValue a)
+      , ToJSON (ResolvedValue a)
+      ) => Resolve a where
   type ResolvedValue a
   resolve :: Context -> Options -> a -> Maybe (ResolvedValue a, Bool)
 

Duckling/Testing/Types.hs

@@ -46,11 +46,11 @@ examplesCustom :: TestPredicate -> [Text] -> [Example]
 examplesCustom check = map (, check)
 
 simpleCheck :: ToJSON a => a -> TestPredicate
-simpleCheck json _ Resolved{jsonValue = v} = toJSON json == v
+simpleCheck json _ Resolved{rval = RVal _ v} = toJSON json == toJSON v
 
 parserCheck :: Eq a => a -> (Value -> Maybe a) -> TestPredicate
-parserCheck expected parse _ Resolved{jsonValue = v} =
+parserCheck expected parse _ Resolved{rval = RVal _ v} =
-  maybe False (expected ==) $ parse v
+  maybe False (expected ==) $ parse (toJSON v)
 
 examples :: ToJSON a => a -> [Text] -> [Example]
 examples output = examplesCustom (simpleCheck output)

Duckling/Time/Corpus.hs

@@ -67,7 +67,7 @@ datetimeOpenInterval dir d g ctx = TimeValue tv [tv] Nothing
 
 
 check :: ToJSON a => (Context -> a) -> TestPredicate
-check f context Resolved{jsonValue} = case jsonValue of
+check f context Resolved{rval = RVal _ v} = case toJSON v of
   Object o -> deleteValues (toJSON (f context)) == deleteValues (Object o)
   _ -> False
   where

Duckling/Types.hs

@@ -76,7 +76,6 @@ instance Hashable Token where
 instance NFData Token where
   rnf (Token _ v) = rnf v
 
-
 -- -----------------------------------------------------------------
 -- Dimension
 
@@ -188,6 +187,19 @@ instance GEq Dimension where
 isDimension :: Dimension a -> Token -> Bool
 isDimension dim (Token dim' _) = isJust $ geq dim dim'
 
+data ResolvedVal
+  = forall a . ( Resolve a, Eq (ResolvedValue a)
+               , Show (ResolvedValue a)
+               , ToJSON (ResolvedValue a)) =>
+    RVal (Dimension a) (ResolvedValue a)
+
+deriving instance Show ResolvedVal
+
+instance Eq ResolvedVal where
+  RVal d1 v1 == RVal d2 v2
+    | Just Refl <- geq d1 d2 = v1 == v2
+    | otherwise = False
+
 data Node = Node
   { nodeRange :: Range
   , token     :: Token
@@ -198,14 +210,15 @@ data Node = Node
 data ResolvedToken = Resolved
   { range :: Range
   , node :: Node
-  , jsonValue :: Value
+  , rval :: ResolvedVal
   , isLatent :: Bool
   } deriving (Eq, Show)
 
 instance Ord ResolvedToken where
-  compare (Resolved range1 _ json1 latent1) (Resolved range2 _ json2 latent2) =
+  compare (Resolved range1 _ (RVal _ v1) latent1)
+          (Resolved range2 _ (RVal _ v2) latent2) =
     case compare range1 range2 of
-      EQ -> case compare (toJText json1) (toJText json2) of
+      EQ -> case compare (toJText v1) (toJText v2) of
         EQ -> compare latent1 latent2
         z -> z
       z  -> z
@@ -264,18 +277,18 @@ instance Show Rule where
 data Entity = Entity
   { dim    :: Text
   , body   :: Text
-  , value  :: Value
+  , value  :: ResolvedVal
   , start  :: Int
   , end    :: Int
   , latent :: Bool
   , enode  :: Node
-  } deriving (Eq, Generic, Show, NFData)
+  } deriving (Eq, Generic, Show)
 
 instance ToJSON Entity where
-  toJSON ent = object
+  toJSON ent@Entity{value = RVal _ val} = object
     [ "dim"    .= dim ent
     , "body"   .= body ent
-    , "value"  .= value ent
+    , "value"  .= val
     , "start"  .= start ent
     , "end"    .= end ent
     , "latent" .= latent ent

README.md

@@ -103,7 +103,7 @@ in|within|after <duration> (in two minutes)
 -- -- -- regex (two)
 -- -- minute (grain) (minutes)
 -- -- -- regex (minutes)
-[Entity {dim = "time", body = "in two minutes", value = "{\"values\":[{\"value\":\"2013-02-12T04:32:00.000-02:00\",\"grain\":\"second\",\"type\":\"value\"}],\"value\":\"2013-02-12T04:32:00.000-02:00\",\"grain\":\"second\",\"type\":\"value\"}", start = 0, end = 14}]
+[Entity {dim = "time", body = "in two minutes", value = RVal Time (TimeValue (SimpleValue (InstantValue {vValue = 2013-02-12 04:32:00 -0200, vGrain = Second})) [SimpleValue (InstantValue {vValue = 2013-02-12 04:32:00 -0200, vGrain = Second})] Nothing), start = 0, end = 14}]
 ```
 
 ## License

duckling.cabal

@@ -1,5 +1,5 @@
 name:                duckling
-version:             0.1.5.0
+version:             0.1.6.0
 synopsis:            A Haskell library for parsing text into structured data.
 description:
   Duckling is a library for parsing text into structured data.

tests/Duckling/Api/Tests.hs

@@ -8,7 +8,6 @@
 
 {-# LANGUAGE NoRebindableSyntax #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
 
 module Duckling.Api.Tests
   ( tests
@@ -42,10 +41,10 @@ parseTest :: TestTree
 parseTest = testCase "Parse Test" $
   case parse sentence testContext testOptions [This Numeral] of
     [] -> assertFailure "empty result"
-    (Entity dim body value start end _ _:_) -> do
+    (Entity dim body (RVal _ v) start end _ _:_) -> do
       assertEqual "dim" "number" dim
       assertEqual "body" "42" body
-      assertEqual "value" val (toJText value)
+      assertEqual "value" val (toJText v)
       assertEqual "start" 4 start
       assertEqual "end" 6 end
   where