mirror of
https://github.com/facebook/duckling.git
synced 2024-10-27 14:26:54 +03:00
41800a3171
Summary: No need to reinvent the wheel when `dependent-sum` has what we need. I re-export `Some(..)` from `Duckling.Dimensions.Types` to cut down on import bloat. Instead of a `Read` instance I created a `fromName` function. Reviewed By: zilberstein Differential Revision: D4710014 fbshipit-source-id: 1d4e86d
85 lines
2.6 KiB
Haskell
85 lines
2.6 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 NamedFieldPuns #-}
|
|
{-# LANGUAGE NoRebindableSyntax #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Duckling.Debug
|
|
( allParses
|
|
, debug
|
|
, fullParses
|
|
, ptree
|
|
) where
|
|
|
|
import qualified Data.HashSet as HashSet
|
|
import Data.Maybe
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.IO as Text
|
|
import Prelude
|
|
|
|
import Duckling.Api
|
|
import Duckling.Dimensions.Types
|
|
import Duckling.Engine
|
|
import Duckling.Lang
|
|
import Duckling.Resolve
|
|
import Duckling.Rules
|
|
import Duckling.Testing.Types
|
|
import Duckling.Types
|
|
|
|
-- -----------------------------------------------------------------
|
|
-- API
|
|
|
|
debug :: Lang -> Text -> [Some Dimension] -> IO [Entity]
|
|
debug l = debugContext testContext {lang = l}
|
|
|
|
allParses :: Lang -> Text -> [Some Dimension] -> IO [Entity]
|
|
allParses l sentence targets = debugTokens sentence $ parses l sentence targets
|
|
|
|
fullParses :: Lang -> Text -> [Some Dimension] -> IO [Entity]
|
|
fullParses l sentence targets = debugTokens sentence .
|
|
filter (\(Resolved {range = Range start end}) -> start == 0 && end == n) $
|
|
parses l sentence targets
|
|
where
|
|
n = Text.length sentence
|
|
|
|
ptree :: Text -> ResolvedToken -> IO ()
|
|
ptree sentence Resolved {node} = pnode sentence 0 node
|
|
|
|
-- -----------------------------------------------------------------
|
|
-- Internals
|
|
|
|
parses :: Lang -> Text -> [Some Dimension] -> [ResolvedToken]
|
|
parses l sentence targets = flip filter tokens $
|
|
\(Resolved {node = Node{token = (Token d _)}}) ->
|
|
case targets of
|
|
[] -> True
|
|
_ -> elem (This d) targets
|
|
where
|
|
tokens = parseAndResolve rules sentence testContext {lang = l}
|
|
rules = rulesFor l $ HashSet.fromList targets
|
|
|
|
debugContext :: Context -> Text -> [Some Dimension] -> IO [Entity]
|
|
debugContext context sentence targets =
|
|
debugTokens sentence . analyze sentence context $ HashSet.fromList targets
|
|
|
|
debugTokens :: Text -> [ResolvedToken] -> IO [Entity]
|
|
debugTokens sentence tokens = do
|
|
mapM_ (ptree sentence) tokens
|
|
return $ map (formatToken sentence) tokens
|
|
|
|
pnode :: Text -> Int -> Node -> IO ()
|
|
pnode sentence depth Node {children, rule, nodeRange = Range start end} = do
|
|
Text.putStrLn out
|
|
mapM_ (pnode sentence (depth + 1)) children
|
|
where
|
|
out = Text.concat [ Text.replicate depth "-- ", name, " (", body, ")" ]
|
|
name = fromMaybe "regex" rule
|
|
body = Text.drop start $ Text.take end sentence
|