duckling/Duckling/Debug.hs
Steven Troxler ce3614fedd In Debug.hs, s/sentence/input/g
Summary:
When tracing the code from Debug downward, the unnecessary rename
of an argument from `sentence` to `input` creates a context switch. Let's
use the same name throughout.

Reviewed By: chessai

Differential Revision: D28213244

fbshipit-source-id: 22476d958312e5c60cd32ff1e3d0d460cf0c8c79
2021-05-06 08:54:57 -07:00

92 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.
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
module Duckling.Debug
( allParses
, debug
, debugCustom
, fullParses
, ptree
) where
import Data.Maybe
import Data.Text (Text)
import Prelude
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Duckling.Api
import Duckling.Dimensions.Types
import Duckling.Engine
import Duckling.Locale
import Duckling.Resolve
import Duckling.Rules
import Duckling.Testing.Types
import Duckling.Types
-- -----------------------------------------------------------------
-- API
debug :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
debug locale = debugCustom testContext {locale = locale} testOptions
allParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
allParses l input targets = debugTokens input $ parses l input targets
fullParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
fullParses l input targets =
debugTokens
input
$ filter
(\Resolved{range = Range start end} -> start == 0 && end == n)
$ parses l input targets
where
n = Text.length input
debugCustom :: Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]
debugCustom context options input targets =
debugTokens
input
$ analyze input context options $ HashSet.fromList targets
ptree :: Text -> Entity -> IO ()
ptree input Entity {enode} = pnode input 0 enode
-- -----------------------------------------------------------------
-- Internals
parses :: Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses l input targets =
filter isRelevantDimension tokens
where
tokens = parseAndResolve rules input testContext {locale = l} testOptions
rules = rulesFor l $ HashSet.fromList targets
isRelevantDimension Resolved{node = Node{token = (Token d _)}} =
case targets of
[] -> True
_ -> elem (Seal d) targets
debugTokens :: Text -> [ResolvedToken] -> IO [Entity]
debugTokens input tokens = do
mapM_ (ptree input) entities
return entities
where entities = map (formatToken input) tokens
pnode :: Text -> Int -> Node -> IO ()
pnode input depth Node {children, rule, nodeRange = Range start end} = do
Text.putStrLn out
mapM_ (pnode input (depth + 1)) children
where
out = Text.concat [ Text.replicate depth "-- ", name, " (", body, ")" ]
name = fromMaybe "regex" rule
body = Text.drop start $ Text.take end input