{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE BangPatterns #-}
module Faker
(
Fake(..)
, FakerSettings
, FakerException(..)
, defaultFakerSettings
, setLocale
, setRandomGen
, setDeterministic
, setNonDeterministic
, setCacheField
, setCacheFile
, replaceCacheField
, replaceCacheFile
, getRandomGen
, getLocale
, getDeterministic
, getCacheField
, getCacheFile
, generate
, 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.Text (Text)
import Data.Typeable
import Data.Vector (Vector)
import Data.Word (Word64)
import Data.Yaml (Value)
import Faker.Internal.Types (CacheFieldKey, CacheFileKey)
import System.Random (StdGen, mkStdGen, newStdGen, split)
data FakerSettings = FakerSettings
{ fslocale :: !Text
, fsrandomGen :: !StdGen
, fsDeterministic :: !Bool
, fsCacheField :: (IORef (HM.HashMap CacheFieldKey (Vector Text)))
, fsCacheFile :: (IORef (HM.HashMap CacheFileKey Value))
}
newtype FakerGen = FakerGen
{ unFakerGen :: (Int, StdGen)
} deriving (Show)
instance Show FakerSettings where
show (FakerSettings {..}) =
show fslocale ++ show fsrandomGen ++ show fsDeterministic
data FakerException
= InvalidLocale String
| InvalidField String
Text
| NoDataFound FakerSettings
| ParseError String
deriving (Typeable, Show)
instance Exception FakerException
defaultFakerSettings :: FakerSettings
defaultFakerSettings =
FakerSettings
{ fslocale = "en"
, fsrandomGen = mkStdGen 10000
, fsDeterministic = True
, fsCacheField = error "defaultFakerSettings: fsCacheField not initialized"
, fsCacheFile = error "defaultFakerSettings: fsCacheFile not initialized"
}
setLocale :: Text -> FakerSettings -> FakerSettings
setLocale localeTxt fs = fs {fslocale = localeTxt}
setRandomGen :: StdGen -> FakerSettings -> FakerSettings
setRandomGen gen fs = fs {fsrandomGen = gen}
getRandomGen :: FakerSettings -> StdGen
getRandomGen settings = fsrandomGen settings
getLocale :: FakerSettings -> Text
getLocale FakerSettings {..} = fslocale
setDeterministic :: FakerSettings -> FakerSettings
setDeterministic fs = fs {fsDeterministic = True}
setNonDeterministic :: FakerSettings -> FakerSettings
setNonDeterministic fs = fs {fsDeterministic = False}
getDeterministic :: FakerSettings -> Bool
getDeterministic FakerSettings {..} = fsDeterministic
getCacheField :: FakerSettings -> IO (HM.HashMap CacheFieldKey (Vector Text))
getCacheField FakerSettings {..} = readIORef fsCacheField
setCacheField ::
HM.HashMap CacheFieldKey (Vector Text) -> FakerSettings -> IO ()
setCacheField cache fs = do
writeIORef (fsCacheField fs) cache
replaceCacheField ::
HM.HashMap CacheFieldKey (Vector Text) -> FakerSettings -> IO FakerSettings
replaceCacheField cache fs = do
ref <- newIORef cache
pure $ fs {fsCacheField = ref}
getCacheFile :: FakerSettings -> IO (HM.HashMap CacheFileKey Value)
getCacheFile FakerSettings {..} = readIORef fsCacheFile
setCacheFile :: HM.HashMap CacheFileKey Value -> FakerSettings -> IO ()
setCacheFile cache fs = writeIORef (fsCacheFile fs) cache
replaceCacheFile ::
HM.HashMap CacheFileKey Value -> FakerSettings -> IO FakerSettings
replaceCacheFile cache fs = do
ref <- newIORef cache
pure $ fs {fsCacheFile = ref}
newtype Fake a = Fake
{ unFake :: FakerSettings -> IO a
}
instance Functor Fake where
fmap :: (a -> b) -> Fake a -> Fake b
fmap f (Fake h) =
Fake
(\r -> do
a <- h r
let b = f a
pure b)
instance Applicative Fake where
pure x = Fake (\_ -> pure x)
(<*>) = ap
instance Monad Fake where
return :: a -> Fake a
return x = Fake (\_ -> return x)
(>>=) :: Fake a -> (a -> Fake b) -> Fake b
(Fake h) >>= k =
Fake
(\settings ->
let stdGen = getRandomGen settings
(r1, _) = split stdGen
m = do
(item :: a) <- h settings
let (Fake k1) = k item
k1 (setRandomGen r1 settings)
in m)
instance MonadIO Fake where
liftIO :: IO a -> Fake a
liftIO xs = Fake (\_ -> xs >>= pure)
generate :: Fake a -> IO a
generate (Fake f) = do
cacheField <- newIORef HM.empty
cacheFile <- newIORef HM.empty
f $ defaultFakerSettings {fsCacheField = cacheField, fsCacheFile = cacheFile}
generateWithSettings :: FakerSettings -> Fake a -> IO a
generateWithSettings settings (Fake f) = do
let deterministic = getDeterministic settings
stdGen <-
if deterministic
then pure $ getRandomGen settings
else newStdGen
let newSettings = setRandomGen stdGen settings
cacheField <- newIORef HM.empty
cacheFile <- newIORef HM.empty
f $ newSettings {fsCacheField = cacheField, fsCacheFile = cacheFile}