{-# 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
  , generateNonDeterministic
  , 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.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
  {-# INLINE fmap #-}
  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
  {-# INLINE pure #-}
  pure x = Fake (\_ -> pure x)
  {-# INLINE (<*>) #-}
  (<*>) = ap
instance Monad Fake where
  {-# INLINE return #-}
  return :: a -> Fake a
  return x = Fake (\_ -> return x)
  {-# INLINE (>>=) #-}
  (>>=) :: Fake a -> (a -> Fake b) -> Fake b
  f >>= k = generateNewFake f k
generateNewFake :: Fake a -> (a -> Fake b) -> Fake b
generateNewFake (Fake h) k = Fake (\settings -> do
  let deterministic = getDeterministic settings
      currentStdGen = getRandomGen settings
      newStdGen = if deterministic
                  then currentStdGen
                  else fst $ split currentStdGen
  item <- h settings
  let (Fake k1) = k item
  k1 (setRandomGen newStdGen settings))
{-# SPECIALIZE INLINE generateNewFake :: Fake Text -> (Text -> Fake Text) -> Fake Text #-}
instance MonadIO Fake where
  liftIO :: IO a -> Fake a
  liftIO xs = Fake (\_ -> xs >>= pure)
instance Semigroup a => Semigroup (Fake a) where
  mx <> my = (<>) <$> mx <*> my
instance Monoid a => Monoid (Fake a) where
  mempty = pure mempty
  mappend mx my = mappend <$> mx <*> my
generate :: Fake a -> IO a
generate (Fake f) = do
  cacheField <- newIORef HM.empty
  cacheFile <- newIORef HM.empty
  f $ defaultFakerSettings {fsCacheField = cacheField, fsCacheFile = cacheFile}
generateNonDeterministic :: Fake a -> IO a
generateNonDeterministic = generateWithSettings $ setNonDeterministic defaultFakerSettings
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}