-- 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 AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Duckling.Types where

import Control.DeepSeq
import Data.Aeson
import Data.GADT.Compare
import Data.GADT.Show
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.List (intersperse, sortOn)
import Data.Maybe
import Data.Text (Text, toLower, unpack)
import Data.Typeable ((:~:)(Refl), eqT, Typeable)
import GHC.Generics
import Prelude
import TextShow (TextShow(..))
import qualified Data.ByteString.Lazy as LB
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as TT
import qualified Data.Text.Encoding as Text
import qualified Text.Regex.Base as R
import qualified Text.Regex.PCRE as PCRE
import qualified TextShow as TS

import Duckling.AmountOfMoney.Types (AmountOfMoneyData)
import Duckling.CreditCardNumber.Types (CreditCardNumberData)
import Duckling.Distance.Types (DistanceData)
import Duckling.Duration.Types (DurationData)
import Duckling.Email.Types (EmailData)
import Duckling.Locale
import Duckling.Numeral.Types (NumeralData)
import Duckling.Ordinal.Types (OrdinalData)
import Duckling.PhoneNumber.Types (PhoneNumberData)
import Duckling.Quantity.Types (QuantityData)
import Duckling.Regex.Types
import Duckling.Resolve
import Duckling.Temperature.Types (TemperatureData)
import Duckling.Time.Types (TimeData)
import Duckling.TimeGrain.Types (Grain)
import Duckling.Url.Types (UrlData)
import Duckling.Volume.Types (VolumeData)

-- -----------------------------------------------------------------
-- Token

data Token = forall a . (Resolve a, Eq a, Hashable a, Show a, NFData a) =>
  Token (Dimension a) a

deriving instance Show Token
instance Eq Token where
  Token Dimension a
d1 a
v1 == :: Token -> Token -> Bool
== Token Dimension a
d2 a
v2 = case Dimension a -> Dimension a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq Dimension a
d1 Dimension a
d2 of
    Just a :~: a
Refl -> a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
v2
    Maybe (a :~: a)
Nothing   -> Bool
False

instance Hashable Token where
  hashWithSalt :: Int -> Token -> Int
hashWithSalt Int
s (Token Dimension a
dim a
v) = Int -> (Dimension a, a) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Dimension a
dim, a
v)

instance NFData Token where
  rnf :: Token -> ()
rnf (Token Dimension a
_ a
v) = a -> ()
forall a. NFData a => a -> ()
rnf a
v

-- -----------------------------------------------------------------
-- Seal

data Seal s where
  Seal :: s a -> Seal s

instance GEq s => Eq (Seal s) where
  Seal s a
x == :: Seal s -> Seal s -> Bool
== Seal s a
y =
    s a -> s a -> Bool
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Bool
defaultEq s a
x s a
y

instance GShow s => Show (Seal s) where
  showsPrec :: Int -> Seal s -> ShowS
showsPrec Int
p (Seal s a
s)
    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (String -> ShowS
showString String
"Seal " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> s a -> ShowS
forall k (t :: k -> *) (a :: k). GShow t => Int -> t a -> ShowS
gshowsPrec Int
11 s a
s)

withSeal :: Seal s -> (forall t. s t -> r) -> r
withSeal :: Seal s -> (forall t. s t -> r) -> r
withSeal (Seal s a
x) forall t. s t -> r
f = s a -> r
forall t. s t -> r
f s a
x

-- -----------------------------------------------------------------
-- Dimension

class (Show a, Typeable a, Typeable (DimensionData  a)) =>
    CustomDimension a where
  type DimensionData a
  dimRules :: a -> [Rule]
  dimLangRules :: Lang -> a -> [Rule]
  dimLocaleRules :: Region -> a -> [Rule]
  dimDependents :: a -> HashSet (Seal Dimension)

-- | GADT for differentiating between dimensions
-- Each dimension should have its own constructor and provide the data structure
-- for its parsed data
data Dimension a where
  RegexMatch :: Dimension GroupMatch
  AmountOfMoney :: Dimension AmountOfMoneyData
  CreditCardNumber :: Dimension CreditCardNumberData
  Distance :: Dimension DistanceData
  Duration :: Dimension DurationData
  Email :: Dimension EmailData
  Numeral :: Dimension NumeralData
  Ordinal :: Dimension OrdinalData
  PhoneNumber :: Dimension PhoneNumberData
  Quantity :: Dimension QuantityData
  Temperature :: Dimension TemperatureData
  Time :: Dimension TimeData
  TimeGrain :: Dimension Grain
  Url :: Dimension UrlData
  Volume :: Dimension VolumeData
  CustomDimension :: CustomDimension a => a -> Dimension (DimensionData a)

-- Show
instance Show (Dimension a) where
  show :: Dimension a -> String
show Dimension a
RegexMatch = String
"RegexMatch"
  show Dimension a
CreditCardNumber = String
"CreditCardNumber"
  show Dimension a
Distance = String
"Distance"
  show Dimension a
Duration = String
"Duration"
  show Dimension a
Email = String
"Email"
  show Dimension a
AmountOfMoney = String
"AmountOfMoney"
  show Dimension a
Numeral = String
"Numeral"
  show Dimension a
Ordinal = String
"Ordinal"
  show Dimension a
PhoneNumber = String
"PhoneNumber"
  show Dimension a
Quantity = String
"Quantity"
  show Dimension a
Temperature = String
"Temperature"
  show Dimension a
Time = String
"Time"
  show Dimension a
TimeGrain = String
"TimeGrain"
  show Dimension a
Url = String
"Url"
  show Dimension a
Volume = String
"Volume"
  show (CustomDimension a
dim) = a -> String
forall a. Show a => a -> String
show a
dim
instance GShow Dimension where gshowsPrec :: Int -> Dimension a -> ShowS
gshowsPrec = Int -> Dimension a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec

-- TextShow
instance TextShow (Dimension a) where
  showb :: Dimension a -> Builder
showb Dimension a
d = String -> Builder
TS.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Dimension a -> String
forall a. Show a => a -> String
show Dimension a
d
instance TextShow (Seal Dimension) where
  showb :: Seal Dimension -> Builder
showb (Seal Dimension a
d) = Dimension a -> Builder
forall a. TextShow a => a -> Builder
showb Dimension a
d

-- Hashable
instance Hashable (Seal Dimension) where
  hashWithSalt :: Int -> Seal Dimension -> Int
hashWithSalt Int
s (Seal Dimension a
a) = Int -> Dimension a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Dimension a
a
instance Hashable (Dimension a) where
  hashWithSalt :: Int -> Dimension a -> Int
hashWithSalt Int
s Dimension a
RegexMatch          = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
0::Int)
  hashWithSalt Int
s Dimension a
Distance            = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
1::Int)
  hashWithSalt Int
s Dimension a
Duration            = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2::Int)
  hashWithSalt Int
s Dimension a
Email               = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
3::Int)
  hashWithSalt Int
s Dimension a
AmountOfMoney       = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
4::Int)
  hashWithSalt Int
s Dimension a
Numeral             = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
5::Int)
  hashWithSalt Int
s Dimension a
Ordinal             = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
6::Int)
  hashWithSalt Int
s Dimension a
PhoneNumber         = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
7::Int)
  hashWithSalt Int
s Dimension a
Quantity            = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
8::Int)
  hashWithSalt Int
s Dimension a
Temperature         = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
9::Int)
  hashWithSalt Int
s Dimension a
Time                = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
10::Int)
  hashWithSalt Int
s Dimension a
TimeGrain           = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
11::Int)
  hashWithSalt Int
s Dimension a
Url                 = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
12::Int)
  hashWithSalt Int
s Dimension a
Volume              = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
13::Int)
  hashWithSalt Int
s (CustomDimension a
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
14::Int)
  hashWithSalt Int
s Dimension a
CreditCardNumber    = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
15::Int)

instance GEq Dimension where
  geq :: Dimension a -> Dimension b -> Maybe (a :~: b)
geq Dimension a
RegexMatch Dimension b
RegexMatch = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
RegexMatch Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
CreditCardNumber Dimension b
CreditCardNumber = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
CreditCardNumber Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Distance Dimension b
Distance = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Distance Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Duration Dimension b
Duration = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Duration Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Email Dimension b
Email = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Email Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
AmountOfMoney Dimension b
AmountOfMoney = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
AmountOfMoney Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Numeral Dimension b
Numeral = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Numeral Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Ordinal Dimension b
Ordinal = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Ordinal Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
PhoneNumber Dimension b
PhoneNumber = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
PhoneNumber Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Quantity Dimension b
Quantity = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Quantity Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Temperature Dimension b
Temperature = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Temperature Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Time Dimension b
Time = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Time Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
TimeGrain Dimension b
TimeGrain = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
TimeGrain Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Url Dimension b
Url = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Url Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq Dimension a
Volume Dimension b
Volume = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq Dimension a
Volume Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
  geq (CustomDimension (a
_ :: a)) (CustomDimension (a
_ :: b))
    | Just a :~: a
Refl <- Maybe (a :~: a)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (a :~: b) = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  geq (CustomDimension a
_) Dimension b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

isDimension :: Dimension a -> Token -> Bool
isDimension :: Dimension a -> Token -> Bool
isDimension Dimension a
dim (Token Dimension a
dim' a
_) = Maybe (a :~: a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a :~: a) -> Bool) -> Maybe (a :~: a) -> Bool
forall a b. (a -> b) -> a -> b
$ Dimension a -> Dimension a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq Dimension a
dim Dimension a
dim'

data ResolvedVal
  = forall a . ( Resolve a, Eq (ResolvedValue a)
               , Show (ResolvedValue a)
               , ToJSON (ResolvedValue a)) =>
    RVal (Dimension a) (ResolvedValue a)

deriving instance Show ResolvedVal

instance Eq ResolvedVal where
  RVal Dimension a
d1 ResolvedValue a
v1 == :: ResolvedVal -> ResolvedVal -> Bool
== RVal Dimension a
d2 ResolvedValue a
v2
    | Just a :~: a
Refl <- Dimension a -> Dimension a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq Dimension a
d1 Dimension a
d2 = ResolvedValue a
v1 ResolvedValue a -> ResolvedValue a -> Bool
forall a. Eq a => a -> a -> Bool
== ResolvedValue a
ResolvedValue a
v2
    | Bool
otherwise = Bool
False

data Node = Node
  { Node -> Range
nodeRange :: Range
  , Node -> Token
token     :: Token
  , Node -> [Node]
children  :: [Node]
  , Node -> Maybe Text
rule      :: Maybe Text
  } deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic, Int -> Node -> Int
Node -> Int
(Int -> Node -> Int) -> (Node -> Int) -> Hashable Node
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Node -> Int
$chash :: Node -> Int
hashWithSalt :: Int -> Node -> Int
$chashWithSalt :: Int -> Node -> Int
Hashable, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Node -> ()
(Node -> ()) -> NFData Node
forall a. (a -> ()) -> NFData a
rnf :: Node -> ()
$crnf :: Node -> ()
NFData)

data ResolvedToken = Resolved
  { ResolvedToken -> Range
range :: Range
  , ResolvedToken -> Node
node :: Node
  , ResolvedToken -> ResolvedVal
rval :: ResolvedVal
  , ResolvedToken -> Bool
isLatent :: Bool
  } deriving (ResolvedToken -> ResolvedToken -> Bool
(ResolvedToken -> ResolvedToken -> Bool)
-> (ResolvedToken -> ResolvedToken -> Bool) -> Eq ResolvedToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedToken -> ResolvedToken -> Bool
$c/= :: ResolvedToken -> ResolvedToken -> Bool
== :: ResolvedToken -> ResolvedToken -> Bool
$c== :: ResolvedToken -> ResolvedToken -> Bool
Eq, Int -> ResolvedToken -> ShowS
[ResolvedToken] -> ShowS
ResolvedToken -> String
(Int -> ResolvedToken -> ShowS)
-> (ResolvedToken -> String)
-> ([ResolvedToken] -> ShowS)
-> Show ResolvedToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedToken] -> ShowS
$cshowList :: [ResolvedToken] -> ShowS
show :: ResolvedToken -> String
$cshow :: ResolvedToken -> String
showsPrec :: Int -> ResolvedToken -> ShowS
$cshowsPrec :: Int -> ResolvedToken -> ShowS
Show)

instance Ord ResolvedToken where
  compare :: ResolvedToken -> ResolvedToken -> Ordering
compare (Resolved Range
range1 Node
_ (RVal Dimension a
_ ResolvedValue a
v1) Bool
latent1)
          (Resolved Range
range2 Node
_ (RVal Dimension a
_ ResolvedValue a
v2) Bool
latent2) =
    case Range -> Range -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Range
range1 Range
range2 of
      Ordering
EQ -> case Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ResolvedValue a -> Text
forall x. ToJSON x => x -> Text
toJText ResolvedValue a
v1) (ResolvedValue a -> Text
forall x. ToJSON x => x -> Text
toJText ResolvedValue a
v2) of
        Ordering
EQ -> Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
latent1 Bool
latent2
        Ordering
z -> Ordering
z
      Ordering
z  -> Ordering
z

data Candidate = Candidate ResolvedToken Double Bool
  deriving (Candidate -> Candidate -> Bool
(Candidate -> Candidate -> Bool)
-> (Candidate -> Candidate -> Bool) -> Eq Candidate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Candidate -> Candidate -> Bool
$c/= :: Candidate -> Candidate -> Bool
== :: Candidate -> Candidate -> Bool
$c== :: Candidate -> Candidate -> Bool
Eq, Int -> Candidate -> ShowS
[Candidate] -> ShowS
Candidate -> String
(Int -> Candidate -> ShowS)
-> (Candidate -> String)
-> ([Candidate] -> ShowS)
-> Show Candidate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Candidate] -> ShowS
$cshowList :: [Candidate] -> ShowS
show :: Candidate -> String
$cshow :: Candidate -> String
showsPrec :: Int -> Candidate -> ShowS
$cshowsPrec :: Int -> Candidate -> ShowS
Show)

instance Ord Candidate where
  compare :: Candidate -> Candidate -> Ordering
compare (Candidate Resolved{range :: ResolvedToken -> Range
range = Range Int
s1 Int
e1, node :: ResolvedToken -> Node
node = Node{token :: Node -> Token
token = Token Dimension a
d1 a
_}} Double
score1 Bool
t1)
          (Candidate Resolved{range :: ResolvedToken -> Range
range = Range Int
s2 Int
e2, node :: ResolvedToken -> Node
node = Node{token :: Node -> Token
token = Token
tok2}} Double
score2 Bool
t2)
    | Dimension a -> Token -> Bool
forall a. Dimension a -> Token -> Bool
isDimension Dimension a
d1 Token
tok2 = case Ordering
starts of
        Ordering
EQ -> case Ordering
ends of
          Ordering
EQ -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
score1 Double
score2
          Ordering
z -> Ordering
z
        Ordering
LT -> case Ordering
ends of
          Ordering
LT -> Ordering
EQ
          Ordering
_ -> Ordering
GT
        Ordering
GT -> case Ordering
ends of
          Ordering
GT -> Ordering
EQ
          Ordering
_ -> Ordering
LT
    | Bool
t1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
t2 = Ordering
compRange
    | Bool
t1 Bool -> Bool -> Bool
&& Ordering
compRange Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Ordering
GT
    | Bool
t2 Bool -> Bool -> Bool
&& Ordering
compRange Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = Ordering
LT
    | Bool
otherwise = Ordering
EQ
      where
        starts :: Ordering
starts = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
s1 Int
s2
        ends :: Ordering
ends = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
e1 Int
e2
        -- a > b if a recovers b
        compRange :: Ordering
compRange = case Ordering
starts of
          Ordering
EQ -> Ordering
ends
          Ordering
LT -> case Ordering
ends of
            Ordering
LT -> Ordering
EQ
            Ordering
_  -> Ordering
GT
          Ordering
GT -> case Ordering
ends of
            Ordering
GT -> Ordering
EQ
            Ordering
_  -> Ordering
LT

data Range = Range Int Int
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Eq Range
Eq Range
-> (Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
$cp1Ord :: Eq Range
Ord, (forall x. Range -> Rep Range x)
-> (forall x. Rep Range x -> Range) -> Generic Range
forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Range x -> Range
$cfrom :: forall x. Range -> Rep Range x
Generic, Int -> Range -> Int
Range -> Int
(Int -> Range -> Int) -> (Range -> Int) -> Hashable Range
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Range -> Int
$chash :: Range -> Int
hashWithSalt :: Int -> Range -> Int
$chashWithSalt :: Int -> Range -> Int
Hashable, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, Range -> ()
(Range -> ()) -> NFData Range
forall a. (a -> ()) -> NFData a
rnf :: Range -> ()
$crnf :: Range -> ()
NFData)

type Production = [Token] -> Maybe Token
type Predicate = Token -> Bool
data PatternItem = Regex PCRE.Regex | Predicate Predicate

type Pattern = [PatternItem]

data Rule = Rule
  { Rule -> Text
name :: Text
  , Rule -> Pattern
pattern :: Pattern
  , Rule -> Production
prod :: Production
  }

instance Show Rule where
  show :: Rule -> String
show (Rule Text
name Pattern
_ Production
_) = Text -> String
forall a. Show a => a -> String
show Text
name

data Entity = Entity
  { Entity -> Text
dim    :: Text
  , Entity -> Text
body   :: Text
  , Entity -> ResolvedVal
value  :: ResolvedVal
  , Entity -> Int
start  :: Int
  , Entity -> Int
end    :: Int
  , Entity -> Bool
latent :: Bool
  , Entity -> Node
enode  :: Node
  } deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, (forall x. Entity -> Rep Entity x)
-> (forall x. Rep Entity x -> Entity) -> Generic Entity
forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Entity x -> Entity
$cfrom :: forall x. Entity -> Rep Entity x
Generic, Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
Show)

instance ToJSON Entity where
  toJSON :: Entity -> Value
toJSON ent :: Entity
ent@Entity{value :: Entity -> ResolvedVal
value = RVal Dimension a
_ ResolvedValue a
val} = [Pair] -> Value
object
    [ Text
"dim"    Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Entity -> Text
dim Entity
ent
    , Text
"body"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Entity -> Text
body Entity
ent
    , Text
"value"  Text -> ResolvedValue a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResolvedValue a
val
    , Text
"start"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Entity -> Int
start Entity
ent
    , Text
"end"    Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Entity -> Int
end Entity
ent
    , Text
"latent" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Entity -> Bool
latent Entity
ent
    ]

toJText :: ToJSON x => x -> Text
toJText :: x -> Text
toJText = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (x -> ByteString) -> x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- -----------------------------------------------------------------
-- Predicates helpers

regex :: String -> PatternItem
regex :: String -> PatternItem
regex = Regex -> PatternItem
Regex (Regex -> PatternItem)
-> (String -> Regex) -> String -> PatternItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
R.makeRegexOpts CompOption
compOpts ExecOption
execOpts
  where
    compOpts :: CompOption
compOpts = CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
PCRE.defaultCompOpt CompOption -> CompOption -> CompOption
forall a. Num a => a -> a -> a
+ CompOption
PCRE.compCaseless CompOption -> CompOption -> CompOption
forall a. Num a => a -> a -> a
+ CompOption
PCRE.compUTF8
    execOpts :: ExecOption
execOpts = ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
PCRE.defaultExecOpt

dimension :: Typeable a => Dimension a -> PatternItem
dimension :: Dimension a -> PatternItem
dimension Dimension a
value = (Token -> Bool) -> PatternItem
Predicate ((Token -> Bool) -> PatternItem) -> (Token -> Bool) -> PatternItem
forall a b. (a -> b) -> a -> b
$ Dimension a -> Token -> Bool
forall a. Dimension a -> Token -> Bool
isDimension Dimension a
value

-- -----------------------------------------------------------------
-- Rule Construction helpers

singleStringLookupRule :: HashMap Text a -> Text -> (a -> Maybe Token) -> Rule
singleStringLookupRule :: HashMap Text a -> Text -> (a -> Maybe Token) -> Rule
singleStringLookupRule HashMap Text a
hashMap Text
name a -> Maybe Token
production = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
name
  , pattern :: Pattern
pattern = [ String -> PatternItem
regex (String -> PatternItem) -> String -> PatternItem
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
regexString ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Text -> HashMap Text a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
toLower Text
match) HashMap Text a
hashMap Maybe a -> (a -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe Token
production
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }
  where
    regexString :: Text
regexString =
      Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Text]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
TT.length) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HashMap Text a -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text a
hashMap)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"