-- 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 GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Url.Rules
  ( rules ) where

import Prelude
import Data.String

import Duckling.Dimensions.Types
import Duckling.Regex.Types
import Duckling.Types
import Duckling.Url.Helpers

ruleURL :: Rule
ruleURL :: Rule
ruleURL = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"url"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"((([a-zA-Z]+)://)?(w{2,3}[0-9]*\\.)?(([\\w_-]+\\.)+[a-z]{2,4})(:(\\d+))?(/[^?\\s#]*)?(\\?[^\\s#]+)?(#[\\-,*=&a-z0-9]+)?)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (m:_:_protocol:_:domain:_:_:_port:_path:_query:_)):
       [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (UrlData -> Token) -> UrlData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension UrlData -> UrlData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension UrlData
Url (UrlData -> Maybe Token) -> UrlData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Text -> Text -> UrlData
url Text
m Text
domain
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleLocalhost :: Rule
ruleLocalhost :: Rule
ruleLocalhost = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"localhost"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"((([a-zA-Z]+)://)?localhost(:(\\d+))?(/[^?\\s#]*)?(\\?[^\\s#]+)?)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (m:_:_protocol:_:_port:_path:_query:_)):[Token]
_) ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (UrlData -> Token) -> UrlData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension UrlData -> UrlData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension UrlData
Url (UrlData -> Maybe Token) -> UrlData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Text -> Text -> UrlData
url Text
m Text
"localhost"
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleLocalURL :: Rule
ruleLocalURL :: Rule
ruleLocalURL = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"local url"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(([a-zA-Z]+)://([\\w_-]+)(:(\\d+))?(/[^?\\s#]*)?(\\?[^\\s#]+)?)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (m:_protocol:domain:_:_port:_path:_query:_)):
       [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (UrlData -> Token) -> UrlData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension UrlData -> UrlData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension UrlData
Url (UrlData -> Maybe Token) -> UrlData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Text -> Text -> UrlData
url Text
m Text
domain
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleURL
  , Rule
ruleLocalhost
  , Rule
ruleLocalURL
  ]