{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Faker
  ( -- * Types
    Fake,
    FakeT (.., Fake),
    FakerSettings,
    FakerException (..),
    NonDeterministicSeed (..),
    defaultFakerSettings,

    -- * Setters
    setLocale,
    setRandomGen,
    setDeterministic,
    setNonDeterministic,
    setNonDeterministicSeed,
    setCacheField,
    setCacheFile,
    replaceCacheField,
    replaceCacheFile,

    -- * Getters
    getRandomGen,
    getLocale,
    getDeterministic,
    getNonDeterministicSeed,
    getCacheField,
    getCacheFile,

    -- * Generators
    generate,
    generateNonDeterministic,
    generateNonDeterministicWithFixedSeed,
    generateWithSettings,
  )
where

import Control.Exception (Exception)
import Control.Monad (ap)
import Control.Monad.IO.Class
import qualified Data.HashMap.Strict as HM
import Data.IORef
import Data.Semigroup (Semigroup, (<>))
import Data.Text (Text)
import Data.Typeable
import Data.Vector (Vector)
import Data.Yaml (Value)
import Faker.Internal.Types (AesonKey, CacheFieldKey, CacheFileKey)
import System.Random (StdGen, mkStdGen, newStdGen, split)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as K
#endif

data FakerSettings = FakerSettings
  { -- | Locale settings for your fake data source.
    FakerSettings -> Text
fslocale :: !Text,
    -- | Seed to initialize random generator state
    FakerSettings -> StdGen
fsrandomGen :: !StdGen,
    -- | Controls whether you want
    -- deterministic out. This overrides
    -- 'fsrandomGen'.
    FakerSettings -> Bool
fsDeterministic :: !Bool,
    FakerSettings -> NonDeterministicSeed
fsNonDeterministicBehavior :: !NonDeterministicSeed,
    FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField :: (IORef (HM.HashMap CacheFieldKey (Vector Text))),
    FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheFile :: (IORef (HM.HashMap CacheFileKey Value))
  }

newtype FakerGen = FakerGen
  { FakerGen -> (Int, StdGen)
unFakerGen :: (Int, StdGen)
  }
  deriving (Int -> FakerGen -> ShowS
[FakerGen] -> ShowS
FakerGen -> String
(Int -> FakerGen -> ShowS)
-> (FakerGen -> String) -> ([FakerGen] -> ShowS) -> Show FakerGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FakerGen] -> ShowS
$cshowList :: [FakerGen] -> ShowS
show :: FakerGen -> String
$cshow :: FakerGen -> String
showsPrec :: Int -> FakerGen -> ShowS
$cshowsPrec :: Int -> FakerGen -> ShowS
Show)

instance Show FakerSettings where
  show :: FakerSettings -> String
show (FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..}) =
    Text -> String
forall a. Show a => a -> String
show Text
fslocale String -> ShowS
forall a. [a] -> [a] -> [a]
++ StdGen -> String
forall a. Show a => a -> String
show StdGen
fsrandomGen String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
fsDeterministic

data FakerException
  = -- | This is thrown when it is not able to
    -- find the fake data source for your
    -- localization.
    InvalidLocale String
  | -- | The 'String' represents the field it is
    -- trying to resolve and the 'Key' field
    -- is something you passed on.
    InvalidField
      String
      AesonKey
  | -- | This is thrown when you have no
    -- data. This may likely happen for
    -- locales other than `en`.
    NoDataFound FakerSettings
  | -- | This is thrown when the parsing step
    -- fails. The 'String' represents the error
    -- message.
    ParseError String
  deriving (Typeable, Int -> FakerException -> ShowS
[FakerException] -> ShowS
FakerException -> String
(Int -> FakerException -> ShowS)
-> (FakerException -> String)
-> ([FakerException] -> ShowS)
-> Show FakerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FakerException] -> ShowS
$cshowList :: [FakerException] -> ShowS
show :: FakerException -> String
$cshow :: FakerException -> String
showsPrec :: Int -> FakerException -> ShowS
$cshowsPrec :: Int -> FakerException -> ShowS
Show)

instance Exception FakerException

-- | Default faker settings with locale of \"en\" and Deterministic output.
defaultFakerSettings :: FakerSettings
defaultFakerSettings :: FakerSettings
defaultFakerSettings =
  FakerSettings :: Text
-> StdGen
-> Bool
-> NonDeterministicSeed
-> IORef (HashMap CacheFieldKey (Vector Text))
-> IORef (HashMap CacheFileKey Value)
-> FakerSettings
FakerSettings
    { fslocale :: Text
fslocale = Text
"en",
      fsrandomGen :: StdGen
fsrandomGen = Int -> StdGen
mkStdGen Int
10000,
      fsDeterministic :: Bool
fsDeterministic = Bool
True,
      fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField = String -> IORef (HashMap CacheFieldKey (Vector Text))
forall a. HasCallStack => String -> a
error String
"defaultFakerSettings: fsCacheField not initialized",
      fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheFile = String -> IORef (HashMap CacheFileKey Value)
forall a. HasCallStack => String -> a
error String
"defaultFakerSettings: fsCacheFile not initialized",
      fsNonDeterministicBehavior :: NonDeterministicSeed
fsNonDeterministicBehavior = NonDeterministicSeed
NewSeed
    }

-- | Sets the locale. Note that for any other locale apart from
-- \"en\", you need to make sure that the data is acutally present. In
-- case no data is found, 'NoDataFound' exception will be thrown. You
-- can check the presence of the data in a particular locale by
-- inspecting the `yml` file of the corresponding locale. The file
-- would be bundled along with the particular Hackage release.
setLocale :: Text -> FakerSettings -> FakerSettings
setLocale :: Text -> FakerSettings -> FakerSettings
setLocale Text
localeTxt FakerSettings
fs = FakerSettings
fs {fslocale :: Text
fslocale = Text
localeTxt}

-- | Sets the initial gen for random generator
setRandomGen :: StdGen -> FakerSettings -> FakerSettings
setRandomGen :: StdGen -> FakerSettings -> FakerSettings
setRandomGen StdGen
gen FakerSettings
fs = FakerSettings
fs {fsrandomGen :: StdGen
fsrandomGen = StdGen
gen}

-- | Get the initial gen for random generator
getRandomGen :: FakerSettings -> StdGen
getRandomGen :: FakerSettings -> StdGen
getRandomGen FakerSettings
settings = FakerSettings -> StdGen
fsrandomGen FakerSettings
settings

-- | Get the Locale settings for your fake data source
getLocale :: FakerSettings -> Text
getLocale :: FakerSettings -> Text
getLocale FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..} = Text
fslocale

-- | Sets the 'NonDeterministicSeed'
setNonDeterministicSeed :: NonDeterministicSeed -> FakerSettings -> FakerSettings
setNonDeterministicSeed :: NonDeterministicSeed -> FakerSettings -> FakerSettings
setNonDeterministicSeed NonDeterministicSeed
seed FakerSettings
fs = FakerSettings
fs { fsNonDeterministicBehavior :: NonDeterministicSeed
fsNonDeterministicBehavior = NonDeterministicSeed
seed }

-- | Set the output of fakedata to be deterministic. With this you
-- will get the same ouput for the functions every time.
--
-- @
-- λ> import qualified Faker.Name as FN
-- λ> :t FN.name
-- FN.name :: Fake Text
-- λ> generateWithSettings (setDeterministic defaultFakerSettings) FN.name
-- "Antony Langosh"
-- λ> generateWithSettings (setDeterministic defaultFakerSettings) FN.name
-- "Antony Langosh"
-- @
setDeterministic :: FakerSettings -> FakerSettings
setDeterministic :: FakerSettings -> FakerSettings
setDeterministic FakerSettings
fs = FakerSettings
fs {fsDeterministic :: Bool
fsDeterministic = Bool
True}

-- | Set the output of fakedata to be non deterministic. With this you
-- will get different ouput for the fake functions.
--
-- @
-- λ> generateWithSettings (setNonDeterministic defaultFakerSettings) FN.name
-- "Macy Shanahan"
-- λ> generateWithSettings (setNonDeterministic defaultFakerSettings) FN.name
-- "Rudy Dickinson II"
-- @
setNonDeterministic :: FakerSettings -> FakerSettings
setNonDeterministic :: FakerSettings -> FakerSettings
setNonDeterministic FakerSettings
fs = FakerSettings
fs {fsDeterministic :: Bool
fsDeterministic = Bool
False}

-- | Check if the fake data output is deterministic or not. A True
-- value indicates that it is deterministic.
getDeterministic :: FakerSettings -> Bool
getDeterministic :: FakerSettings -> Bool
getDeterministic FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..} = Bool
fsDeterministic

-- | Get the 'NonDeterministicSeed' from faker settings. Note that
-- this setting is only applicable when use non deterministic output.
getNonDeterministicSeed :: FakerSettings -> NonDeterministicSeed
getNonDeterministicSeed :: FakerSettings -> NonDeterministicSeed
getNonDeterministicSeed FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..} = NonDeterministicSeed
fsNonDeterministicBehavior

getCacheField :: FakerSettings -> IO (HM.HashMap CacheFieldKey (Vector Text))
getCacheField :: FakerSettings -> IO (HashMap CacheFieldKey (Vector Text))
getCacheField FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..} = IORef (HashMap CacheFieldKey (Vector Text))
-> IO (HashMap CacheFieldKey (Vector Text))
forall a. IORef a -> IO a
readIORef IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField

setCacheField ::
  HM.HashMap CacheFieldKey (Vector Text) -> FakerSettings -> IO ()
setCacheField :: HashMap CacheFieldKey (Vector Text) -> FakerSettings -> IO ()
setCacheField HashMap CacheFieldKey (Vector Text)
cache FakerSettings
fs = do
  IORef (HashMap CacheFieldKey (Vector Text))
-> HashMap CacheFieldKey (Vector Text) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField FakerSettings
fs) HashMap CacheFieldKey (Vector Text)
cache

replaceCacheField ::
  HM.HashMap CacheFieldKey (Vector Text) -> FakerSettings -> IO FakerSettings
replaceCacheField :: HashMap CacheFieldKey (Vector Text)
-> FakerSettings -> IO FakerSettings
replaceCacheField HashMap CacheFieldKey (Vector Text)
cache FakerSettings
fs = do
  IORef (HashMap CacheFieldKey (Vector Text))
ref <- HashMap CacheFieldKey (Vector Text)
-> IO (IORef (HashMap CacheFieldKey (Vector Text)))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFieldKey (Vector Text)
cache
  FakerSettings -> IO FakerSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FakerSettings -> IO FakerSettings)
-> FakerSettings -> IO FakerSettings
forall a b. (a -> b) -> a -> b
$ FakerSettings
fs {fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField = IORef (HashMap CacheFieldKey (Vector Text))
ref}

getCacheFile :: FakerSettings -> IO (HM.HashMap CacheFileKey Value)
getCacheFile :: FakerSettings -> IO (HashMap CacheFileKey Value)
getCacheFile FakerSettings {Bool
StdGen
Text
IORef (HashMap CacheFileKey Value)
IORef (HashMap CacheFieldKey (Vector Text))
NonDeterministicSeed
fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: NonDeterministicSeed
fsDeterministic :: Bool
fsrandomGen :: StdGen
fslocale :: Text
fsCacheFile :: FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheField :: FakerSettings -> IORef (HashMap CacheFieldKey (Vector Text))
fsNonDeterministicBehavior :: FakerSettings -> NonDeterministicSeed
fsDeterministic :: FakerSettings -> Bool
fsrandomGen :: FakerSettings -> StdGen
fslocale :: FakerSettings -> Text
..} = IORef (HashMap CacheFileKey Value)
-> IO (HashMap CacheFileKey Value)
forall a. IORef a -> IO a
readIORef IORef (HashMap CacheFileKey Value)
fsCacheFile

setCacheFile :: HM.HashMap CacheFileKey Value -> FakerSettings -> IO ()
setCacheFile :: HashMap CacheFileKey Value -> FakerSettings -> IO ()
setCacheFile HashMap CacheFileKey Value
cache FakerSettings
fs = IORef (HashMap CacheFileKey Value)
-> HashMap CacheFileKey Value -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FakerSettings -> IORef (HashMap CacheFileKey Value)
fsCacheFile FakerSettings
fs) HashMap CacheFileKey Value
cache

replaceCacheFile ::
  HM.HashMap CacheFileKey Value -> FakerSettings -> IO FakerSettings
replaceCacheFile :: HashMap CacheFileKey Value -> FakerSettings -> IO FakerSettings
replaceCacheFile HashMap CacheFileKey Value
cache FakerSettings
fs = do
  IORef (HashMap CacheFileKey Value)
ref <- HashMap CacheFileKey Value
-> IO (IORef (HashMap CacheFileKey Value))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFileKey Value
cache
  FakerSettings -> IO FakerSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FakerSettings -> IO FakerSettings)
-> FakerSettings -> IO FakerSettings
forall a b. (a -> b) -> a -> b
$ FakerSettings
fs {fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheFile = IORef (HashMap CacheFileKey Value)
ref}

newtype FakeT m a = FakeT
  { FakeT m a -> FakerSettings -> m a
runFakeT :: FakerSettings -> m a
  }

-- | Fake data type. This is the type you will be using to produce
-- fake values.
type Fake = FakeT IO

pattern Fake :: (FakerSettings -> IO a) -> Fake a
pattern $bFake :: (FakerSettings -> IO a) -> Fake a
$mFake :: forall r a.
Fake a -> ((FakerSettings -> IO a) -> r) -> (Void# -> r) -> r
Fake f = FakeT f

unFake :: Fake a -> FakerSettings -> IO a
unFake :: Fake a -> FakerSettings -> IO a
unFake = Fake a -> FakerSettings -> IO a
forall (m :: * -> *) a. FakeT m a -> FakerSettings -> m a
runFakeT

instance Monad m => Functor (FakeT m) where
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> FakeT m a -> FakeT m b
  fmap :: (a -> b) -> FakeT m a -> FakeT m b
fmap a -> b
f (FakeT FakerSettings -> m a
h) =
    (FakerSettings -> m b) -> FakeT m b
forall (m :: * -> *) a. (FakerSettings -> m a) -> FakeT m a
FakeT
      ( \FakerSettings
r -> do
          a
a <- FakerSettings -> m a
h FakerSettings
r
          let b :: b
b = a -> b
f a
a
          b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
      )

instance Monad m => Applicative (FakeT m) where
  {-# INLINE pure #-}
  pure :: a -> FakeT m a
pure a
x = (FakerSettings -> m a) -> FakeT m a
forall (m :: * -> *) a. (FakerSettings -> m a) -> FakeT m a
FakeT (\FakerSettings
_ -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE (<*>) #-}
  <*> :: FakeT m (a -> b) -> FakeT m a -> FakeT m b
(<*>) = FakeT m (a -> b) -> FakeT m a -> FakeT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (FakeT m) where
  {-# INLINE return #-}
  return :: a -> FakeT m a
  return :: a -> FakeT m a
return a
x = (FakerSettings -> m a) -> FakeT m a
forall (m :: * -> *) a. (FakerSettings -> m a) -> FakeT m a
FakeT (\FakerSettings
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
  {-# INLINE (>>=) #-}
  (>>=) :: FakeT m a -> (a -> FakeT m b) -> FakeT m b
  FakeT m a
f >>= :: FakeT m a -> (a -> FakeT m b) -> FakeT m b
>>= a -> FakeT m b
k = FakeT m a -> (a -> FakeT m b) -> FakeT m b
forall (m :: * -> *) a b.
Monad m =>
FakeT m a -> (a -> FakeT m b) -> FakeT m b
generateNewFake FakeT m a
f a -> FakeT m b
k

generateNewFake :: Monad m => FakeT m a -> (a -> FakeT m b) -> FakeT m b
generateNewFake :: FakeT m a -> (a -> FakeT m b) -> FakeT m b
generateNewFake (FakeT FakerSettings -> m a
h) a -> FakeT m b
k =
  (FakerSettings -> m b) -> FakeT m b
forall (m :: * -> *) a. (FakerSettings -> m a) -> FakeT m a
FakeT
    ( \FakerSettings
settings -> do
        let deterministic :: Bool
deterministic = FakerSettings -> Bool
getDeterministic FakerSettings
settings
            currentStdGen :: StdGen
currentStdGen = FakerSettings -> StdGen
getRandomGen FakerSettings
settings
            newStdGen :: StdGen
newStdGen =
              if Bool
deterministic
                then StdGen
currentStdGen
                else (StdGen, StdGen) -> StdGen
forall a b. (a, b) -> a
fst ((StdGen, StdGen) -> StdGen) -> (StdGen, StdGen) -> StdGen
forall a b. (a -> b) -> a -> b
$ StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
currentStdGen
        a
item <- FakerSettings -> m a
h FakerSettings
settings
        let (FakeT FakerSettings -> m b
k1) = a -> FakeT m b
k a
item
        FakerSettings -> m b
k1 (StdGen -> FakerSettings -> FakerSettings
setRandomGen StdGen
newStdGen FakerSettings
settings)
    )
{-# SPECIALIZE INLINE generateNewFake :: Fake Text -> (Text -> Fake Text) -> Fake Text #-}

instance MonadIO m => MonadIO (FakeT m) where
  liftIO :: IO a -> FakeT m a
  liftIO :: IO a -> FakeT m a
liftIO IO a
xs = (FakerSettings -> m a) -> FakeT m a
forall (m :: * -> *) a. (FakerSettings -> m a) -> FakeT m a
FakeT (\FakerSettings
_ -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
xs)

-- | @since 0.6.1
instance (Semigroup a, Monad m) => Semigroup (FakeT m a) where
  FakeT m a
mx <> :: FakeT m a -> FakeT m a -> FakeT m a
<> FakeT m a
my = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> FakeT m a -> FakeT m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FakeT m a
mx FakeT m (a -> a) -> FakeT m a -> FakeT m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FakeT m a
my

-- | @since 0.6.1
instance (Monoid a, Monad m) => Monoid (FakeT m a) where
  mempty :: FakeT m a
mempty = a -> FakeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mappend :: FakeT m a -> FakeT m a -> FakeT m a
mappend FakeT m a
mx FakeT m a
my = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> FakeT m a -> FakeT m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FakeT m a
mx FakeT m (a -> a) -> FakeT m a -> FakeT m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FakeT m a
my

-- | Generate fake value with 'defaultFakerSettings'. This produces
-- deterministic output by default.
--
-- @
-- λ> import qualified Faker.Name as FN
-- λ> generate FN.name
-- "Antony Langosh"
-- @
generate :: MonadIO m => FakeT m a -> m a
generate :: FakeT m a -> m a
generate (FakeT FakerSettings -> m a
f) = do
  IORef (HashMap CacheFieldKey (Vector Text))
cacheField <- IO (IORef (HashMap CacheFieldKey (Vector Text)))
-> m (IORef (HashMap CacheFieldKey (Vector Text)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap CacheFieldKey (Vector Text)))
 -> m (IORef (HashMap CacheFieldKey (Vector Text))))
-> IO (IORef (HashMap CacheFieldKey (Vector Text)))
-> m (IORef (HashMap CacheFieldKey (Vector Text)))
forall a b. (a -> b) -> a -> b
$ HashMap CacheFieldKey (Vector Text)
-> IO (IORef (HashMap CacheFieldKey (Vector Text)))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFieldKey (Vector Text)
forall k v. HashMap k v
HM.empty
  IORef (HashMap CacheFileKey Value)
cacheFile <- IO (IORef (HashMap CacheFileKey Value))
-> m (IORef (HashMap CacheFileKey Value))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap CacheFileKey Value))
 -> m (IORef (HashMap CacheFileKey Value)))
-> IO (IORef (HashMap CacheFileKey Value))
-> m (IORef (HashMap CacheFileKey Value))
forall a b. (a -> b) -> a -> b
$ HashMap CacheFileKey Value
-> IO (IORef (HashMap CacheFileKey Value))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFileKey Value
forall k v. HashMap k v
HM.empty
  FakerSettings -> m a
f (FakerSettings -> m a) -> FakerSettings -> m a
forall a b. (a -> b) -> a -> b
$ FakerSettings
defaultFakerSettings {fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField = IORef (HashMap CacheFieldKey (Vector Text))
cacheField, fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheFile = IORef (HashMap CacheFileKey Value)
cacheFile}

-- | Generate fake value with 'defaultFakerSettings' but with non
-- deterministic setting.
--
-- @since 0.8.0
--
-- @
-- λ> import qualified Faker.Name as FN
-- λ> generateNonDeterministic FN.name
-- "Prof. Antoine O'Conner"
-- λ> generateNonDeterministic FN.name
-- "Savannah Buckridge"
-- @
generateNonDeterministic :: MonadIO m => FakeT m a -> m a
generateNonDeterministic :: FakeT m a -> m a
generateNonDeterministic = FakerSettings -> FakeT m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
FakerSettings -> FakeT m a -> m a
generateWithSettings (FakerSettings -> FakeT m a -> m a)
-> FakerSettings -> FakeT m a -> m a
forall a b. (a -> b) -> a -> b
$ FakerSettings -> FakerSettings
setNonDeterministic FakerSettings
defaultFakerSettings

-- | Generate fake value with supplied 'FakerSettings'
--
-- @
-- λ> generateWithSettings defaultFakerSettings FN.name
-- "Antony Langosh"
-- @
generateWithSettings :: MonadIO m => FakerSettings -> FakeT m a -> m a
generateWithSettings :: FakerSettings -> FakeT m a -> m a
generateWithSettings FakerSettings
settings (FakeT FakerSettings -> m a
f) = do
  let deterministic :: Bool
deterministic = FakerSettings -> Bool
getDeterministic FakerSettings
settings
  StdGen
stdGen <-
    if Bool
deterministic
      then StdGen -> m StdGen
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StdGen -> m StdGen) -> StdGen -> m StdGen
forall a b. (a -> b) -> a -> b
$ FakerSettings -> StdGen
getRandomGen FakerSettings
settings
      else case FakerSettings -> NonDeterministicSeed
fsNonDeterministicBehavior FakerSettings
settings of
        NonDeterministicSeed
FixedSeed -> StdGen -> m StdGen
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StdGen -> m StdGen) -> StdGen -> m StdGen
forall a b. (a -> b) -> a -> b
$ (StdGen, StdGen) -> StdGen
forall a b. (a, b) -> a
fst ((StdGen, StdGen) -> StdGen) -> (StdGen, StdGen) -> StdGen
forall a b. (a -> b) -> a -> b
$ StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split (FakerSettings -> StdGen
getRandomGen FakerSettings
settings)
        NonDeterministicSeed
NewSeed -> IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  let newSettings :: FakerSettings
newSettings = StdGen -> FakerSettings -> FakerSettings
setRandomGen StdGen
stdGen FakerSettings
settings
  IORef (HashMap CacheFieldKey (Vector Text))
cacheField <- IO (IORef (HashMap CacheFieldKey (Vector Text)))
-> m (IORef (HashMap CacheFieldKey (Vector Text)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap CacheFieldKey (Vector Text)))
 -> m (IORef (HashMap CacheFieldKey (Vector Text))))
-> IO (IORef (HashMap CacheFieldKey (Vector Text)))
-> m (IORef (HashMap CacheFieldKey (Vector Text)))
forall a b. (a -> b) -> a -> b
$ HashMap CacheFieldKey (Vector Text)
-> IO (IORef (HashMap CacheFieldKey (Vector Text)))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFieldKey (Vector Text)
forall k v. HashMap k v
HM.empty
  IORef (HashMap CacheFileKey Value)
cacheFile <- IO (IORef (HashMap CacheFileKey Value))
-> m (IORef (HashMap CacheFileKey Value))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap CacheFileKey Value))
 -> m (IORef (HashMap CacheFileKey Value)))
-> IO (IORef (HashMap CacheFileKey Value))
-> m (IORef (HashMap CacheFileKey Value))
forall a b. (a -> b) -> a -> b
$ HashMap CacheFileKey Value
-> IO (IORef (HashMap CacheFileKey Value))
forall a. a -> IO (IORef a)
newIORef HashMap CacheFileKey Value
forall k v. HashMap k v
HM.empty
  FakerSettings -> m a
f (FakerSettings -> m a) -> FakerSettings -> m a
forall a b. (a -> b) -> a -> b
$ FakerSettings
newSettings {fsCacheField :: IORef (HashMap CacheFieldKey (Vector Text))
fsCacheField = IORef (HashMap CacheFieldKey (Vector Text))
cacheField, fsCacheFile :: IORef (HashMap CacheFileKey Value)
fsCacheFile = IORef (HashMap CacheFileKey Value)
cacheFile}

-- | Generate fake value with 'NonDeterministicSeed' as
-- 'FixedSeed'. The difference between 'generateNonDeterministic' and
-- this function is that this uses a fixed seed set via `setRandomGen`
-- as it's initial seed value.
--
-- Executing this function multiple times will result in generation of
-- same values.
--
-- @since 1.0.3
-- @
-- λ> generateNonDeterministicWithFixedSeed $ listOf 5 $ fromRange (1,100)
-- [98,87,77,33,98]
-- λ> generateNonDeterministicWithFixedSeed $ listOf 5 $ fromRange (1,100)
-- [98,87,77,33,98]
-- @
generateNonDeterministicWithFixedSeed :: MonadIO m => FakeT m a -> m a
generateNonDeterministicWithFixedSeed :: FakeT m a -> m a
generateNonDeterministicWithFixedSeed =
  FakerSettings -> FakeT m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
FakerSettings -> FakeT m a -> m a
generateWithSettings (FakerSettings -> FakeT m a -> m a)
-> FakerSettings -> FakeT m a -> m a
forall a b. (a -> b) -> a -> b
$
    FakerSettings -> FakerSettings
setNonDeterministic
      ( FakerSettings
defaultFakerSettings
          { fsNonDeterministicBehavior :: NonDeterministicSeed
fsNonDeterministicBehavior = NonDeterministicSeed
FixedSeed
          }
      )

-- | NonDeterministicSeed type which controls if a fixed seed is going
-- to be used or if a new seed will be generated each time.
--
-- @since 1.0.3
data NonDeterministicSeed
  = -- | Always use a fixed seed.
    FixedSeed
  | -- | Use a new seed every time.
    NewSeed