mirror of
https://github.com/facebook/duckling.git
synced 2024-08-18 01:30:35 +03:00
7889f396f3
Summary: Pull Request resolved: https://github.com/facebook/duckling/pull/533 In recent versions of Data.Some the name of the constructor, `This` has changed name to `Some`. This has become rather problematic for us to migrate so we're just going to remove the dependency. The meat of this diff is adding the type `Seal` to `Duckling.Types`. That type replaces `Some`. Reviewed By: pepeiborra Differential Revision: D23929459 fbshipit-source-id: 8ff4146ecba4f1119a17899961b2d877547f6e4f
111 lines
3.0 KiB
Haskell
111 lines
3.0 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.
|
|
|
|
{-# 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.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" [Seal (CustomDimension MyDimension)] >>= print
|
|
debug en "testing my dimension pattern match" [Seal (CustomDimension MyDimension)] >>= print
|