mirror of
https://github.com/facebook/duckling.git
synced 2024-10-27 06:08:17 +03:00
a365dec52a
Summary: Pull Request resolved: https://github.com/facebook/duckling/pull/233 Reviewed By: watashi Differential Revision: D9021889 Pulled By: chinmay87 fbshipit-source-id: 1e134cf6d20006e1ee8824fa2fcbb8f7cdc4f197
113 lines
3.2 KiB
Haskell
113 lines
3.2 KiB
Haskell
-- 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 ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# 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.Regex.Types (GroupMatch(..))
|
|
import Duckling.Resolve (Resolve(..))
|
|
import Duckling.Types
|
|
|
|
data MyDimension = MyDimension deriving (Eq, Show, Typeable)
|
|
|
|
instance CustomDimension MyDimension where
|
|
type DimensionData MyDimension = MyData
|
|
dimRules _ = [myDimensionRule, myDimensionRule']
|
|
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 ]
|
|
|
|
myDimensionPredicate :: Predicate
|
|
myDimensionPredicate (Token (CustomDimension (dim :: a)) dimData)
|
|
| Just Refl <- eqT @a @MyDimension, MyData{..} <- dimData =
|
|
iField == 42 && bField
|
|
myDimensionPredicate _ = False
|
|
|
|
myDimensionRule :: Rule
|
|
myDimensionRule = Rule
|
|
{ name = "my dimension (simple)"
|
|
, pattern =
|
|
[ regex "my dimension"
|
|
]
|
|
, prod = \case
|
|
(_:_) -> Just . Token (CustomDimension MyDimension) $ MyData
|
|
{ iField = 42
|
|
, bField = True
|
|
, tField = "hello world"
|
|
}
|
|
_ -> Nothing
|
|
}
|
|
|
|
myDimensionRule' :: Rule
|
|
myDimensionRule' = Rule
|
|
{ name = "my dimension (pattern match)"
|
|
, pattern =
|
|
[ Predicate myDimensionPredicate
|
|
, regex "pattern match"
|
|
]
|
|
, prod = \case
|
|
((Token (CustomDimension (dim :: a)) dimData):
|
|
Token RegexMatch (GroupMatch _):
|
|
_)
|
|
| Just Refl <- eqT @a @MyDimension, MyData{..} <- dimData ->
|
|
Just . Token (CustomDimension MyDimension) $ MyData
|
|
{ iField = iField * 10
|
|
, bField = not bField
|
|
, tField = "goodnight moon"
|
|
}
|
|
_ -> Nothing
|
|
}
|
|
|
|
main :: IO ()
|
|
main = do
|
|
let en = makeLocale EN Nothing
|
|
debug en "testing my dimension" [This (CustomDimension MyDimension)] >>= print
|
|
debug en "testing my dimension pattern match" [This (CustomDimension MyDimension)] >>= print
|