-- 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 OverloadedStrings #-}

module Duckling.Url.Corpus
  ( corpus
  , negativeCorpus
  ) where

import Data.String
import Prelude

import Duckling.Testing.Types
import Duckling.Url.Types

corpus :: Corpus
corpus :: Corpus
corpus = (Context
testContext, Options
testOptions, [Example]
allExamples)

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
testContext, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"foo"
      , Text
"MYHOST"
      , Text
"hey:42"
      , Text
"25"
      ]

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"http://www.bla.com" Text
"bla.com")
             [ Text
"http://www.bla.com"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"www.bla.com:8080/path" Text
"bla.com")
             [ Text
"www.bla.com:8080/path"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"https://myserver?foo=bar" Text
"myserver")
             [ Text
"https://myserver?foo=bar"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"cnn.com/info" Text
"cnn.com")
             [ Text
"cnn.com/info"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"bla.com/path/path?ext=%23&foo=bla" Text
"bla.com")
             [ Text
"bla.com/path/path?ext=%23&foo=bla"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"localhost" Text
"localhost")
             [ Text
"localhost"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"localhost:8000" Text
"localhost")
             [ Text
"localhost:8000"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"http://kimchi" Text
"kimchi")
             [ Text
"http://kimchi"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"https://500px.com:443/about" Text
"500px.com")
             [ Text
"https://500px.com:443/about"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"www2.foo-bar.net?foo=bar" Text
"foo-bar.net")
             [ Text
"www2.foo-bar.net?foo=bar"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"https://api.wit.ai/message?q=hi" Text
"api.wit.ai")
             [ Text
"https://api.wit.ai/message?q=hi"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"aMaZon.co.uk/?page=home" Text
"amazon.co.uk")
             [ Text
"aMaZon.co.uk/?page=home"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"https://en.wikipedia.org/wiki/Uniform_Resource_Identifier#Syntax" Text
"en.wikipedia.org")
             [ Text
"https://en.wikipedia.org/wiki/Uniform_Resource_Identifier#Syntax"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"http://example.com/data.csv#cell=4,1-6,2" Text
"example.com")
             [ Text
"http://example.com/data.csv#cell=4,1-6,2"
             ]
  , UrlData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Text -> Text -> UrlData
UrlData Text
"http://example.com/bar.webm#t=40,80&xywh=160,120,320,240" Text
"example.com")
             [ Text
"http://example.com/bar.webm#t=40,80&xywh=160,120,320,240"
             ]
  ]