Name.hs

{-# LANGUAGE OverloadedStrings #-}

module Faker.Provider.Name where

import Config
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Yaml
import Faker
import Faker.Internal

parseName :: FromJSON a => FakerSettings -> Value -> Parser a
parseName settings (Object obj) = do
  en <- obj .: (getLocale settings)
  faker <- en .: "faker"
  name <- faker .: "name"
  pure name
parseName settings val = fail $ "expected Object, but got " <> (show val)

parseNameField ::
     (FromJSON a, Monoid a) => FakerSettings -> Text -> Value -> Parser a
parseNameField settings txt val = do
  name <- parseName settings val
  field <- name .:? txt .!= mempty
  pure field

parseUnresolvedNameField ::
     (FromJSON a, Monoid a)
  => FakerSettings
  -> Text
  -> Value
  -> Parser (Unresolved a)
parseUnresolvedNameField settings txt val = do
  name <- parseName settings val
  field <- name .:? txt .!= mempty
  pure $ pure field

parseMaleFirstName ::
     (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
parseMaleFirstName settings = parseNameField settings "male_first_name"

parseFemaleFirstName ::
     (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
parseFemaleFirstName settings = parseNameField settings "female_first_name"

parseFirstName ::
     (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser (Unresolved a)
parseFirstName settings = parseUnresolvedNameField settings "first_name"

parseLastName :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
parseLastName settings = parseNameField settings "last_name"

parsePrefix :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
parsePrefix settings = parseNameField settings "prefix"

parseSuffix :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
parseSuffix settings = parseNameField settings "suffix"

parseFieldName ::
     (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser (Unresolved a)
parseFieldName settings = parseUnresolvedNameField settings "name"

parseNameWithMiddle ::
     (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser (Unresolved a)
parseNameWithMiddle settings =
  parseUnresolvedNameField settings "name_with_middle"

maleFirstNameProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text)
maleFirstNameProvider settings = fetchData settings Name parseMaleFirstName

femaleFirstNameProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text)
femaleFirstNameProvider settings = fetchData settings Name parseFemaleFirstName

firstNameProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Unresolved (Vector Text))
firstNameProvider settings = fetchData settings Name parseFirstName

lastNameProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text)
lastNameProvider settings = fetchData settings Name parseLastName

prefixProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text)
prefixProvider settings = fetchData settings Name parsePrefix

suffixProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text)
suffixProvider settings = fetchData settings Name parseSuffix

nameProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Unresolved (Vector Text))
nameProvider settings = fetchData settings Name parseFieldName

nameWithMiddleProvider ::
     (MonadThrow m, MonadIO m) => FakerSettings -> m (Unresolved (Vector Text))
nameWithMiddleProvider settings = fetchData settings Name parseNameWithMiddle

resolveNameText :: (MonadIO m, MonadThrow m) => FakerSettings -> Text -> m Text
resolveNameText settings txt = do
  let fields = resolveFields txt
  nameFields <- mapM (resolveNameField settings) fields
  pure $ operateFields txt nameFields

resolveNameField :: (MonadThrow m, MonadIO m) => FakerSettings -> Text -> m Text
resolveNameField settings "female_first_name" =
  randomVec settings femaleFirstNameProvider
resolveNameField settings "male_first_name" =
  randomVec settings maleFirstNameProvider
resolveNameField settings "prefix" = randomVec settings prefixProvider
resolveNameField settings "suffix" = randomVec settings suffixProvider
resolveNameField settings "first_name" =
  randomUnresolvedVec settings firstNameProvider resolveNameText
resolveNameField settings "last_name" = randomVec settings lastNameProvider
resolveNameField settings str = throwM $ InvalidField "name" str