-- 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 -> Text -> [Seal Dimension] -> IO [Entity]
debug Locale
locale = Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]
debugCustom Context
testContext {locale :: Locale
locale = Locale
locale} Options
testOptions

allParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
allParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
allParses Locale
l Text
sentence [Seal Dimension]
targets = Text -> [ResolvedToken] -> IO [Entity]
debugTokens Text
sentence ([ResolvedToken] -> IO [Entity]) -> [ResolvedToken] -> IO [Entity]
forall a b. (a -> b) -> a -> b
$ Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses Locale
l Text
sentence [Seal Dimension]
targets

fullParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
fullParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]
fullParses Locale
l Text
sentence [Seal Dimension]
targets = Text -> [ResolvedToken] -> IO [Entity]
debugTokens Text
sentence ([ResolvedToken] -> IO [Entity])
-> ([ResolvedToken] -> [ResolvedToken])
-> [ResolvedToken]
-> IO [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (ResolvedToken -> Bool) -> [ResolvedToken] -> [ResolvedToken]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Resolved{range :: ResolvedToken -> Range
range = Range Int
start Int
end} -> Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) ([ResolvedToken] -> IO [Entity]) -> [ResolvedToken] -> IO [Entity]
forall a b. (a -> b) -> a -> b
$
  Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses Locale
l Text
sentence [Seal Dimension]
targets
  where
    n :: Int
n = Text -> Int
Text.length Text
sentence

debugCustom :: Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]
debugCustom :: Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]
debugCustom Context
context Options
options Text
sentence [Seal Dimension]
targets = Text -> [ResolvedToken] -> IO [Entity]
debugTokens Text
sentence ([ResolvedToken] -> IO [Entity])
-> (HashSet (Seal Dimension) -> [ResolvedToken])
-> HashSet (Seal Dimension)
-> IO [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text
-> Context
-> Options
-> HashSet (Seal Dimension)
-> [ResolvedToken]
analyze Text
sentence Context
context Options
options (HashSet (Seal Dimension) -> IO [Entity])
-> HashSet (Seal Dimension) -> IO [Entity]
forall a b. (a -> b) -> a -> b
$ [Seal Dimension] -> HashSet (Seal Dimension)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [Seal Dimension]
targets

ptree :: Text -> Entity -> IO ()
ptree :: Text -> Entity -> IO ()
ptree Text
sentence Entity {Node
enode :: Entity -> Node
enode :: Node
enode} = Text -> Int -> Node -> IO ()
pnode Text
sentence Int
0 Node
enode

-- -----------------------------------------------------------------
-- Internals

parses :: Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses :: Locale -> Text -> [Seal Dimension] -> [ResolvedToken]
parses Locale
l Text
sentence [Seal Dimension]
targets = ((ResolvedToken -> Bool) -> [ResolvedToken] -> [ResolvedToken])
-> [ResolvedToken] -> (ResolvedToken -> Bool) -> [ResolvedToken]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResolvedToken -> Bool) -> [ResolvedToken] -> [ResolvedToken]
forall a. (a -> Bool) -> [a] -> [a]
filter [ResolvedToken]
tokens ((ResolvedToken -> Bool) -> [ResolvedToken])
-> (ResolvedToken -> Bool) -> [ResolvedToken]
forall a b. (a -> b) -> a -> b
$
  \Resolved{node :: ResolvedToken -> Node
node = Node{token :: Node -> Token
token = (Token Dimension a
d a
_)}} ->
    case [Seal Dimension]
targets of
      [] -> Bool
True
      [Seal Dimension]
_ -> Seal Dimension -> [Seal Dimension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Dimension a -> Seal Dimension
forall (s :: * -> *) a. s a -> Seal s
Seal Dimension a
d) [Seal Dimension]
targets
  where
    tokens :: [ResolvedToken]
tokens = [Rule] -> Text -> Context -> Options -> [ResolvedToken]
parseAndResolve [Rule]
rules Text
sentence Context
testContext {locale :: Locale
locale = Locale
l} Options
testOptions
    rules :: [Rule]
rules = Locale -> HashSet (Seal Dimension) -> [Rule]
rulesFor Locale
l (HashSet (Seal Dimension) -> [Rule])
-> HashSet (Seal Dimension) -> [Rule]
forall a b. (a -> b) -> a -> b
$ [Seal Dimension] -> HashSet (Seal Dimension)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [Seal Dimension]
targets

debugTokens :: Text -> [ResolvedToken] -> IO [Entity]
debugTokens :: Text -> [ResolvedToken] -> IO [Entity]
debugTokens Text
sentence [ResolvedToken]
tokens = do
  (Entity -> IO ()) -> [Entity] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Entity -> IO ()
ptree Text
sentence) [Entity]
entities
  [Entity] -> IO [Entity]
forall (m :: * -> *) a. Monad m => a -> m a
return [Entity]
entities
  where entities :: [Entity]
entities = (ResolvedToken -> Entity) -> [ResolvedToken] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ResolvedToken -> Entity
formatToken Text
sentence) [ResolvedToken]
tokens

pnode :: Text -> Int -> Node -> IO ()
pnode :: Text -> Int -> Node -> IO ()
pnode Text
sentence Int
depth Node {[Node]
children :: Node -> [Node]
children :: [Node]
children, Maybe Text
rule :: Node -> Maybe Text
rule :: Maybe Text
rule, nodeRange :: Node -> Range
nodeRange = Range Int
start Int
end} = do
  Text -> IO ()
Text.putStrLn Text
out
  (Node -> IO ()) -> [Node] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Int -> Node -> IO ()
pnode Text
sentence (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [Node]
children
  where
    out :: Text
out = [Text] -> Text
Text.concat [ Int -> Text -> Text
Text.replicate Int
depth Text
"-- ", Text
name, Text
" (", Text
body, Text
")" ]
    name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"regex" Maybe Text
rule
    body :: Text
body = Int -> Text -> Text
Text.drop Int
start (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.take Int
end Text
sentence