{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Faker.Company
  ( buzzword
  , suffix
  , bs
  , name
  , industry
  , profession
  , type'
  , sicCode
  , email
  , domain
  ) where

import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T 
import qualified Data.Vector as V
import Faker
import Faker.Internal
import Faker.Provider.Company
import Faker.TH
import qualified Faker.Internet as F
import qualified Faker.Name as F
import qualified Faker.Combinators as F
import Data.Char(isAlphaNum)

$(generateFakeField "company" "suffix")

buzzword :: Fake Text
buzzword :: Fake Text
buzzword =
  (FakerSettings -> IO Text) -> Fake Text
forall a. (FakerSettings -> IO a) -> Fake a
Fake
    (\FakerSettings
settings -> do
       Vector (Vector Text)
vec :: V.Vector (V.Vector Text) <- FakerSettings -> IO (Vector (Vector Text))
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FakerSettings -> m (Vector (Vector Text))
companyBuzzwordsProvider FakerSettings
settings
       let IO (Vector Text)
item :: IO (V.Vector Text) = FakerSettings -> Vector (Vector Text) -> IO (Vector Text)
forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
FakerSettings -> Vector a -> m a
rvec FakerSettings
settings Vector (Vector Text)
vec
       Vector Text
item' <- IO (Vector Text)
item
       FakerSettings -> Vector Text -> IO Text
forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
FakerSettings -> Vector a -> m a
rvec FakerSettings
settings Vector Text
item')

bs :: Fake Text
bs :: Fake Text
bs =
  (FakerSettings -> IO Text) -> Fake Text
forall a. (FakerSettings -> IO a) -> Fake a
Fake
    (\FakerSettings
settings -> do
       Vector (Vector Text)
vec :: V.Vector (V.Vector Text) <- FakerSettings -> IO (Vector (Vector Text))
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FakerSettings -> m (Vector (Vector Text))
companyBsProvider FakerSettings
settings
       let Vector (IO Text)
item :: V.Vector (IO Text) = (Vector Text -> IO Text)
-> Vector (Vector Text) -> Vector (IO Text)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (FakerSettings -> Vector Text -> IO Text
forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
FakerSettings -> Vector a -> m a
rvec FakerSettings
settings) Vector (Vector Text)
vec
           IO (Vector Text)
item' :: IO (V.Vector Text) = Vector (IO Text) -> IO (Vector Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
sequence Vector (IO Text)
item
       Vector Text
items <- IO (Vector Text)
item'
       let txt :: Text
txt = (Text -> Text -> Text) -> Vector Text -> Text
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
a Text
b -> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b) Vector Text
items
       Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt)

$(generateFakeFieldUnresolved "company" "name")

$(generateFakeField "company" "industry")

$(generateFakeField "company" "profession")

$(generateFakeField "company" "type")

-- | SIC code for classifying industries.
--
-- @since 0.2.0
--
$(generateFakeField "company" "sic_code")

-- | Generates a domain name like "crazychairauction.com"
--
-- @since 0.8.1
--
domain :: Fake Text
domain :: Fake Text
domain = do
  Text
suffix <- Fake Text
F.domainSuffix
  Text
companyName <- Fake Text
name
  Text -> Fake Text
forall a. a -> FakeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Fake Text) -> Text -> Fake Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
sanitise Text
companyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
  where
  -- Replaces spaces with hyphens and filters out anything that isn't an
  -- alphanumeric character or a hyphen, so the domain has a better chance of
  -- conforming to RFC 1035.
  --
  -- See: https://datatracker.ietf.org/doc/html/rfc1035#section-2.3.1
  sanitise :: Text -> Text
  sanitise :: Text -> Text
sanitise = (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"-"

-- | Generates an email like "jappie_klooster@crazychairauction.com"
--
-- @since 0.8.1
email :: Fake Text
email :: Fake Text
email = do
  Text
humanName <-  Fake Text
F.name
  Int
number <- forall a (m :: * -> *). (Monad m, Random a) => (a, a) -> FakeT m a
F.fromRange @Int (Int
0, Int
999999999) -- reasonable uniqueness
  Text
domainName <- Fake Text
domain
  let numText :: Text
      numText :: Text
numText = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
number
  Text -> Fake Text
forall a. a -> FakeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Fake Text) -> Text -> Fake Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
sanitise Text
humanName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
domainName
  where
  -- Ensures the spaces are replaced by "_",
  -- and no special characters are in the name.
  -- So "Elizabeth Warder!" becomes "Elizabeth_Warder".
  -- Any fancy symbols such as "!@#$" etc are filtered out.
  sanitise :: Text -> Text
  sanitise :: Text -> Text
sanitise = (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"_"