{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Internal module used for configuration purposes. You don't likely
-- have to use it.
module Config
  ( SourceData(..)
  , fetchData
  , fetchDataSingle
  , mapSource
  , populateLocales
  ) where

import Control.Monad (filterM)
import Control.Monad.Catch
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import Data.Monoid ((<>))
import Data.Text (Text, pack, unpack)
import Data.Vector (Vector)
import Data.Yaml
import Faker
import Faker.Internal.Types (CacheFileKey(..), SourceData(..))
import Language.Haskell.TH (Name)
import Paths_fakedata (getDataFileName)
import System.Directory (doesFileExist, listDirectory)
import System.FilePath ((<.>), (</>), takeExtension, takeFileName)

localesDirectory :: FilePath
localesDirectory :: [Char]
localesDirectory = [Char]
"faker/lib/locales"

localesEnDirectory :: FilePath
localesEnDirectory :: [Char]
localesEnDirectory = [Char]
"faker/lib/locales/en"

localesCustomEnDirectory :: FilePath
localesCustomEnDirectory :: [Char]
localesCustomEnDirectory = [Char]
"customFakeSource/en"

isLocaleFile :: FilePath -> IO Bool
isLocaleFile :: [Char] -> IO Bool
isLocaleFile [Char]
fname = do
  Bool
exist <- [Char] -> IO Bool
doesFileExist [Char]
fname
  Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
exist Bool -> Bool -> Bool
&& ([Char] -> [Char]
takeExtension [Char]
fname [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".yml"))

listLocaleFiles :: FilePath -> IO [FilePath]
listLocaleFiles :: [Char] -> IO [[Char]]
listLocaleFiles [Char]
fname = do
  [[Char]]
files <- [Char] -> IO [[Char]]
listDirectory [Char]
fname
  ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
isLocaleFile [[Char]]
files

populateLocales :: IO [Text]
populateLocales :: IO [Text]
populateLocales = do
  [[Char]]
files <- [Char] -> IO [[Char]]
listLocaleFiles [Char]
localesDirectory
  let files' :: [Text]
files' = ([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
pack ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeFileName) [[Char]]
files
  [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
files'

sourceFile :: SourceData -> FilePath
sourceFile :: SourceData -> [Char]
sourceFile SourceData
Address = [Char]
"address"
sourceFile SourceData
Name = [Char]
"name"
sourceFile SourceData
Ancient = [Char]
"ancient"
sourceFile SourceData
Adjective = [Char]
"adjective"
sourceFile SourceData
Animal = [Char]
"animal"
sourceFile SourceData
App = [Char]
"app"
sourceFile SourceData
Appliance = [Char]
"appliance"
sourceFile SourceData
ATHF = [Char]
"aqua_teen_hunger_force"
sourceFile SourceData
Artist = [Char]
"artist"
sourceFile SourceData
BTTF = [Char]
"back_to_the_future"
sourceFile SourceData
Bank = [Char]
"bank"
sourceFile SourceData
Beer = [Char]
"beer"
sourceFile SourceData
BoJackHorseman = [Char]
"bojack_horseman"
sourceFile SourceData
Book = [Char]
"book"
sourceFile SourceData
BossaNova = [Char]
"bossa_nova"
sourceFile SourceData
BreakingBad = [Char]
"breaking_bad"
sourceFile SourceData
Buffy = [Char]
"buffy"
sourceFile SourceData
Business = [Char]
"business"
sourceFile SourceData
Cannabis = [Char]
"cannabis"
sourceFile SourceData
BigBangTheory = [Char]
"big_bang_theory"
sourceFile SourceData
Cat = [Char]
"cat"
sourceFile SourceData
ChuckNorris = [Char]
"chuck_norris"
sourceFile SourceData
Code = [Char]
"code"
sourceFile SourceData
Coffee = [Char]
"coffee"
sourceFile SourceData
Coin = [Char]
"coin"
sourceFile SourceData
Color = [Char]
"color"
sourceFile SourceData
Horse = [Char]
"horse"
sourceFile SourceData
Commerce = [Char]
"commerce"
sourceFile SourceData
Community = [Char]
"community"
sourceFile SourceData
Compass = [Char]
"compass"
sourceFile SourceData
Company = [Char]
"company"
sourceFile SourceData
Construction = [Char]
"construction"
sourceFile SourceData
Cosmere = [Char]
"cosmere"
sourceFile SourceData
CryptoCoin = [Char]
"crypto_coin"
sourceFile SourceData
CultureSeries = [Char]
"culture_series"
sourceFile SourceData
Currency = [Char]
"currency"
sourceFile SourceData
DcComics = [Char]
"dc_comics"
sourceFile SourceData
Demographic = [Char]
"demographic"
sourceFile SourceData
Dessert = [Char]
"dessert"
sourceFile SourceData
Device = [Char]
"device"
sourceFile SourceData
Dog = [Char]
"dog"
sourceFile SourceData
Dota = [Char]
"dota"
sourceFile SourceData
DrWho = [Char]
"dr_who"
sourceFile SourceData
DragonBall = [Char]
"dragon_ball"
sourceFile SourceData
DumbAndDumber = [Char]
"dumb_and_dumber"
sourceFile SourceData
Dune = [Char]
"dune"
sourceFile SourceData
Educator = [Char]
"educator"
sourceFile SourceData
ElderScrolls = [Char]
"elder_scrolls"
sourceFile SourceData
ElectricalComponents = [Char]
"electrical_components"
sourceFile SourceData
Esport = [Char]
"esport"
sourceFile SourceData
Fallout = [Char]
"fallout"
sourceFile SourceData
FamilyGuy = [Char]
"family_guy"
sourceFile SourceData
File = [Char]
"file"
sourceFile SourceData
Finance = [Char]
"finance"
sourceFile SourceData
Food = [Char]
"food"
sourceFile SourceData
Football = [Char]
"football"
sourceFile SourceData
FreshPrinceOfBelAir = [Char]
"fresh_prince_of_bel_air"
sourceFile SourceData
Friends = [Char]
"friends"
sourceFile SourceData
FunnyName = [Char]
"funny_name"
sourceFile SourceData
JackHandey = [Char]
"jack_handey"
sourceFile SourceData
GameOfThrones = [Char]
"game_of_thrones"
sourceFile SourceData
Gender = [Char]
"gender"
sourceFile SourceData
GhostBusters = [Char]
"ghostbusters"
sourceFile SourceData
GratefulDead = [Char]
"grateful_dead"
sourceFile SourceData
GreekPhilosophers = [Char]
"greek_philosophers"
sourceFile SourceData
Hacker = [Char]
"hacker"
sourceFile SourceData
HalfLife = [Char]
"half_life"
sourceFile SourceData
HarryPotter = [Char]
"harry_potter"
sourceFile SourceData
Heroes = [Char]
"heroes"
sourceFile SourceData
HeroesOfTheStorm = [Char]
"heroes_of_the_storm"
sourceFile SourceData
HeyArnold = [Char]
"hey_arnold"
sourceFile SourceData
Hipster = [Char]
"hipster"
sourceFile SourceData
HitchhikersGuideToTheGalaxy = [Char]
"hitchhikers_guide_to_the_galaxy"
sourceFile SourceData
Hobbit = [Char]
"hobbit"
sourceFile SourceData
House = [Char]
"house"
sourceFile SourceData
HowIMetYourMother = [Char]
"how_i_met_your_mother"
sourceFile SourceData
IdNumber = [Char]
"id_number"
sourceFile SourceData
IndustrySegments = [Char]
"industry_segments"
sourceFile SourceData
Internet = [Char]
"internet"
sourceFile SourceData
Invoice = [Char]
"invoice"
sourceFile SourceData
Job = [Char]
"job"
sourceFile SourceData
Kpop = [Char]
"kpop"
sourceFile SourceData
LeagueOfLegends = [Char]
"league_of_legends"
sourceFile SourceData
Lebowski = [Char]
"lebowski"
sourceFile SourceData
LordOfTheRings = [Char]
"lord_of_the_rings"
sourceFile SourceData
Lorem = [Char]
"lorem"
sourceFile SourceData
LoveCraft = [Char]
"lovecraft"
sourceFile SourceData
Markdown = [Char]
"markdown"
sourceFile SourceData
Marketing = [Char]
"marketing"
sourceFile SourceData
Measurement = [Char]
"measurement"
sourceFile SourceData
MichaelScott = [Char]
"michael_scott"
sourceFile SourceData
Military = [Char]
"military"
sourceFile SourceData
Movie = [Char]
"movie"
sourceFile SourceData
Music = [Char]
"music"
sourceFile SourceData
Myst = [Char]
"myst"
sourceFile SourceData
Nation = [Char]
"nation"
sourceFile SourceData
NatoPhoneticAlphabet = [Char]
"nato_phonetic_alphabet"
sourceFile SourceData
NewGirl = [Char]
"new_girl"
sourceFile SourceData
OnePiece = [Char]
"one_piece"
sourceFile SourceData
OverWatch = [Char]
"overwatch"
sourceFile SourceData
ParksAndRec = [Char]
"parks_and_rec"
sourceFile SourceData
Phish = [Char]
"phish"
sourceFile SourceData
PhoneNumber = [Char]
"phone_number"
sourceFile SourceData
Pokemon = [Char]
"pokemon"
sourceFile SourceData
PrincessBride = [Char]
"princess_bride"
sourceFile SourceData
ProgrammingLanguage = [Char]
"programming_language"
sourceFile SourceData
Quote = [Char]
"quote"
sourceFile SourceData
Relationship = [Char]
"relationship"
sourceFile SourceData
Restaurant = [Char]
"restaurant"
sourceFile SourceData
RickAndMorty = [Char]
"rick_and_morty"
sourceFile SourceData
RockBand = [Char]
"rock_band"
sourceFile SourceData
Rupaul = [Char]
"rupaul"
sourceFile SourceData
Science = [Char]
"science"
sourceFile SourceData
Seinfeld = [Char]
"seinfeld"
sourceFile SourceData
Shakespeare = [Char]
"shakespeare"
sourceFile SourceData
SiliconValley = [Char]
"silicon_valley"
sourceFile SourceData
Simpsons = [Char]
"simpsons"
sourceFile SourceData
SlackEmoji = [Char]
"slack_emoji"
sourceFile SourceData
SonicTheHedgehog = [Char]
"sonic_the_hedgehog"
sourceFile SourceData
Source = [Char]
"source"
sourceFile SourceData
SouthPark = [Char]
"south_park"
sourceFile SourceData
Space = [Char]
"space"
sourceFile SourceData
StarTrek = [Char]
"star_trek"
sourceFile SourceData
StarWars = [Char]
"star_wars"
sourceFile SourceData
StarGate = [Char]
"stargate"
sourceFile SourceData
StrangerThings = [Char]
"stranger_thing"
sourceFile SourceData
Stripe = [Char]
"stripe"
sourceFile SourceData
Subscription = [Char]
"subscription"
sourceFile SourceData
SuperSmashBros = [Char]
"super_smash_bros"
sourceFile SourceData
SuperHero = [Char]
"superhero"
sourceFile SourceData
SwordArtOnline = [Char]
"sword_art_online"
sourceFile SourceData
Team = [Char]
"team"
sourceFile SourceData
TheExpanse = [Char]
"the_expanse"
sourceFile SourceData
TheItCrowd = [Char]
"the_it_crowd"
sourceFile SourceData
TheThickOfIt = [Char]
"the_thick_of_it"
sourceFile SourceData
TwinPeaks = [Char]
"twin_peaks"
sourceFile SourceData
UmphreysMcgee = [Char]
"umphreys_mcgee"
sourceFile SourceData
University = [Char]
"university"
sourceFile SourceData
VForVendetta = [Char]
"v_for_vendetta"
sourceFile SourceData
Vehicle = [Char]
"vehicle"
sourceFile SourceData
VentureBros = [Char]
"venture_bros"
sourceFile SourceData
Verbs = [Char]
"verbs"
sourceFile SourceData
Witcher = [Char]
"witcher"
sourceFile SourceData
WorldCup = [Char]
"world_cup"
sourceFile SourceData
WorldOfWarcraft = [Char]
"world_of_warcraft"
sourceFile SourceData
Yoda = [Char]
"yoda"
sourceFile SourceData
Zelda = [Char]
"zelda"
sourceFile SourceData
Basketball = [Char]
"basketball"
sourceFile SourceData
Opera = [Char]
"opera"
sourceFile SourceData
Blood = [Char]
"blood"
sourceFile SourceData
Chiquito = [Char]
"chiquito"
sourceFile SourceData
Computer = [Char]
"computer"
sourceFile SourceData
Control = [Char]
"control"
sourceFile SourceData
Departed = [Char]
"departed"
sourceFile SourceData
DnD = [Char]
"dnd"
sourceFile SourceData
PearlJam = [Char]
"pearl_jam"
sourceFile SourceData
Rajnikanth = [Char]
"rajnikanth"
sourceFile SourceData
Show = [Char]
"show"
sourceFile SourceData
WarhammerFantasy = [Char]
"warhammer_fantasy"
sourceFile SourceData
Suits = [Char]
"suits"
sourceFile SourceData
Barcode = [Char]
"barcode"
sourceFile SourceData
DrivingLicense = [Char]
"driving_license"
sourceFile SourceData
Drone = [Char]
"drone"
sourceFile SourceData
Futurama = [Char]
"futurama"
sourceFile SourceData
Minecraft = [Char]
"minecraft"
sourceFile SourceData
Prince = [Char]
"prince"
sourceFile SourceData
Rush = [Char]
"rush"
sourceFile SourceData
StreetFighter = [Char]
"street_fighter"
sourceFile SourceData
StudioGhibli = [Char]
"studio_ghibli"
sourceFile SourceData
Bird = [Char]
"bird"
sourceFile SourceData
Camera = [Char]
"camera"
sourceFile SourceData
ClashOfClans = [Char]
"clash_of_clan"
sourceFile SourceData
Conan = [Char]
"conan"
sourceFile SourceData
Doraemon = [Char]
"doraemon"
sourceFile SourceData
FinalSpace = [Char]
"final_space"
sourceFile SourceData
HowToTrainYourDragon = [Char]
"how_to_train_your_dragon"
sourceFile SourceData
Mountain = [Char]
"mountain"
sourceFile SourceData
Naruto = [Char]
"naruto"
sourceFile SourceData
Room = [Char]
"room"
sourceFile SourceData
SuperMario = [Char]
"super_mario"
sourceFile SourceData
Tea = [Char]
"tea"
sourceFile SourceData
Tolkien = [Char]
"tolkien"
sourceFile SourceData
Touhou = [Char]
"touhou"
sourceFile SourceData
Volleyball = [Char]
"volleyball"

mapSource :: Text -> Name
mapSource :: Text -> Name
mapSource Text
"studioGhibli" = 'StudioGhibli
mapSource Text
"streetFighter" = 'StreetFighter
mapSource Text
"prince" = 'Prince
mapSource Text
"minecraft" = 'Minecraft
mapSource Text
"futurama" = 'Futurama
mapSource Text
"rush" = 'Rush
mapSource Text
"drone" = 'Drone
mapSource Text
"drivingLicense" = 'DrivingLicense
mapSource Text
"barcode" = 'Barcode
mapSource Text
"pearl_jam" = 'PearlJam
mapSource Text
"dnd" = 'DnD
mapSource Text
"chiquito" = 'Chiquito
mapSource Text
"departed" = 'Departed
mapSource Text
"computer" = 'Computer
mapSource Text
"control" = 'Control
mapSource Text
"horse" = 'Horse
mapSource Text
"address" = 'Address
mapSource Text
"basketball" = 'Basketball
mapSource Text
"name" = 'Name
mapSource Text
"blood" = 'Blood
mapSource Text
"ancient" = 'Ancient
mapSource Text
"animal" = 'Animal
mapSource Text
"app" = 'App
mapSource Text
"appliance" = 'Appliance
mapSource Text
"aquaTeenHungerForce" = 'ATHF
mapSource Text
"artist" = 'Artist
mapSource Text
"backToTheFuture" = 'BTTF
mapSource Text
"bank" = 'Bank
mapSource Text
"beer" = 'Beer
mapSource Text
"bojackHourseman" = 'BoJackHorseman
mapSource Text
"book" = 'Book
mapSource Text
"bossaNova" = 'BossaNova
mapSource Text
"breakingBad" = 'BreakingBad
mapSource Text
"bigBangTheory" = 'BigBangTheory
mapSource Text
"buffy" = 'Buffy
mapSource Text
"business" = 'Business
mapSource Text
"cannabis" = 'Cannabis
mapSource Text
"cat" = 'Cat
mapSource Text
"chuckNorris" = 'ChuckNorris
mapSource Text
"code" = 'Code
mapSource Text
"coffee" = 'Coffee
mapSource Text
"coin" = 'Coin
mapSource Text
"color" = 'Color
mapSource Text
"commerce" = 'Commerce
mapSource Text
"community" = 'Community
mapSource Text
"company" = 'Company
mapSource Text
"construction" = 'Construction
mapSource Text
"cosmere" = 'Cosmere
mapSource Text
"cryptoCoin" = 'CryptoCoin
mapSource Text
"cultureSeries" = 'CultureSeries
mapSource Text
"currency" = 'Currency
mapSource Text
"dcComics" = 'DcComics
mapSource Text
"demographic" = 'Demographic
mapSource Text
"dessert" = 'Dessert
mapSource Text
"device" = 'Device
mapSource Text
"dog" = 'Dog
mapSource Text
"dota" = 'Dota
mapSource Text
"drWho" = 'DrWho
mapSource Text
"dragonBall" = 'DragonBall
mapSource Text
"dumbAndDumber" = 'DumbAndDumber
mapSource Text
"dune" = 'Dune
mapSource Text
"educator" = 'Educator
mapSource Text
"compass" = 'Compass
mapSource Text
"elderScrolls" = 'ElderScrolls
mapSource Text
"electricalComponents" = 'ElectricalComponents
mapSource Text
"esport" = 'Esport
mapSource Text
"fallout" = 'Fallout
mapSource Text
"familyGuy" = 'FamilyGuy
mapSource Text
"file" = 'File
mapSource Text
"finance" = 'Finance
mapSource Text
"food" = 'Food
mapSource Text
"football" = 'Football
mapSource Text
"freshPrinceOfBelAir" = 'FreshPrinceOfBelAir
mapSource Text
"friends" = 'Friends
mapSource Text
"funnyName" = 'FunnyName
mapSource Text
"gameOfThrones" = 'GameOfThrones
mapSource Text
"gender" = 'Gender
mapSource Text
"ghostbusters" = 'GhostBusters
mapSource Text
"gratefulDead" = 'GratefulDead
mapSource Text
"greekPhilosophers" = 'GreekPhilosophers
mapSource Text
"hacker" = 'Hacker
mapSource Text
"halfLife" = 'HalfLife
mapSource Text
"harryPotter" = 'HarryPotter
mapSource Text
"heroes" = 'Heroes
mapSource Text
"heroesOfTheStorm" = 'HeroesOfTheStorm
mapSource Text
"heyArnold" = 'HeyArnold
mapSource Text
"hipster" = 'Hipster
mapSource Text
"hitchhikersGuideToTheGalaxy" = 'HitchhikersGuideToTheGalaxy
mapSource Text
"hobbit" = 'Hobbit
mapSource Text
"house" = 'House
mapSource Text
"howIMetYourMother" = 'HowIMetYourMother
mapSource Text
"idNumber" = 'IdNumber
mapSource Text
"industrySegments" = 'IndustrySegments
mapSource Text
"internet" = 'Internet
mapSource Text
"invoice" = 'Invoice
mapSource Text
"job" = 'Job
mapSource Text
"kpop" = 'Kpop
mapSource Text
"leagueOfLegends" = 'LeagueOfLegends
mapSource Text
"lebowski" = 'Lebowski
mapSource Text
"lordOfTheRings" = 'LordOfTheRings
mapSource Text
"lorem" = 'Lorem
mapSource Text
"lovecraft" = 'LoveCraft
mapSource Text
"markdown" = 'Markdown
mapSource Text
"marketing" = 'Marketing
mapSource Text
"michaelScott" = 'MichaelScott
mapSource Text
"military" = 'Military
mapSource Text
"movie" = 'Movie
mapSource Text
"music" = 'Music
mapSource Text
"myst" = 'Myst
mapSource Text
"nation" = 'Nation
mapSource Text
"natoPhoneticAlphabet" = 'NatoPhoneticAlphabet
mapSource Text
"newGirl" = 'NewGirl
mapSource Text
"onePiece" = 'OnePiece
mapSource Text
"overwatch" = 'OverWatch
mapSource Text
"parksAndRec" = 'ParksAndRec
mapSource Text
"phish" = 'Phish
mapSource Text
"phoneNumber" = 'PhoneNumber
mapSource Text
"pokemon" = 'Pokemon
mapSource Text
"princessBride" = 'PrincessBride
mapSource Text
"programmingLauguage" = 'ProgrammingLanguage
mapSource Text
"quote" = 'Quote
mapSource Text
"relationship" = 'Relationship
mapSource Text
"restaurant" = 'Restaurant
mapSource Text
"rickAndMorty" = 'RickAndMorty
mapSource Text
"rockBand" = 'RockBand
mapSource Text
"rupaul" = 'Rupaul
mapSource Text
"science" = 'Science
mapSource Text
"seinfeld" = 'Seinfeld
mapSource Text
"shakespeare" = 'Shakespeare
mapSource Text
"siliconValley" = 'SiliconValley
mapSource Text
"simpsons" = 'Simpsons
mapSource Text
"slackEmoji" = 'SlackEmoji
mapSource Text
"sonicTheHedgehog" = 'SonicTheHedgehog
mapSource Text
"source" = 'Source
mapSource Text
"southPark" = 'SouthPark
mapSource Text
"space" = 'Space
mapSource Text
"starTrek" = 'StarTrek
mapSource Text
"starWars" = 'StarWars
mapSource Text
"stargate" = 'StarGate
mapSource Text
"strangerThings" = 'StrangerThings
mapSource Text
"stripe" = 'Stripe
mapSource Text
"subscription" = 'Subscription
mapSource Text
"superSmashBros" = 'SuperSmashBros
mapSource Text
"superhero" = 'SuperHero
mapSource Text
"swordArtOnline" = 'SwordArtOnline
mapSource Text
"team" = 'Team
mapSource Text
"theExpanse" = 'TheExpanse
mapSource Text
"theItCrowd" = 'TheItCrowd
mapSource Text
"theThickOfIt" = 'TheThickOfIt
mapSource Text
"twinPeaks" = 'TwinPeaks
mapSource Text
"umphreysMcgee" = 'UmphreysMcgee
mapSource Text
"university" = 'University
mapSource Text
"vForVendetta" = 'VForVendetta
mapSource Text
"vehicle" = 'Vehicle
mapSource Text
"ventureBros" = 'VentureBros
mapSource Text
"verbs" = 'Verbs
mapSource Text
"witcher" = 'Witcher
mapSource Text
"worldCup" = 'WorldCup
mapSource Text
"worldOfWarcraft" = 'WorldOfWarcraft
mapSource Text
"yoda" = 'Yoda
mapSource Text
"zelda" = 'Zelda
mapSource Text
"measurement" = 'Measurement
mapSource Text
"opera" = 'Opera
mapSource Text
"rajnikanth" = 'Rajnikanth
mapSource Text
"show" = 'Show
mapSource Text
"suits" = 'Suits
mapSource Text
"warhammerFantasy" = 'WarhammerFantasy
mapSource Text
"adjective" = 'Adjective
mapSource Text
"bird" = 'Bird
mapSource Text
"camera" = 'Camera
mapSource Text
"clashOfClans" = 'ClashOfClans
mapSource Text
"conan" = 'Conan
mapSource Text
"doraemon" = 'Doraemon
mapSource Text
"finalSpace" = 'FinalSpace
mapSource Text
"howToTrainYourDragon" = 'HowToTrainYourDragon
mapSource Text
"jackHandey" = 'JackHandey
mapSource Text
"mountain" = 'Mountain
mapSource Text
"naruto" = 'Naruto
mapSource Text
"room" = 'Room
mapSource Text
"superMario" = 'SuperMario
mapSource Text
"tea" = 'Tea
mapSource Text
"tolkien" = 'Tolkien
mapSource Text
"touhou" = 'Touhou
mapSource Text
"volleyball" = 'Volleyball
mapSource Text
item = [Char] -> Name
forall a. HasCallStack => [Char] -> a
error ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ [Char]
"mapSource: Invalid argument passed " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
item)

guessSourceFile :: SourceData -> Text -> FilePath
guessSourceFile :: SourceData -> Text -> [Char]
guessSourceFile SourceData
sdata Text
sysloc =
  case Text
sysloc of
    Text
"en" ->
      case SourceData
sdata of
        SourceData
Finance -> [Char]
localesCustomEnDirectory [Char] -> [Char] -> [Char]
</> (SourceData -> [Char]
sourceFile SourceData
sdata) [Char] -> [Char] -> [Char]
<.> [Char]
"yml"
        SourceData
sdata' -> [Char]
localesEnDirectory [Char] -> [Char] -> [Char]
</> (SourceData -> [Char]
sourceFile SourceData
sdata') [Char] -> [Char] -> [Char]
<.> [Char]
"yml"
    Text
"ja" -> [Char]
localesDirectory [Char] -> [Char] -> [Char]
</> [Char]
"ja" [Char] -> [Char] -> [Char]
</> (SourceData -> [Char]
sourceFile SourceData
sdata) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".yml"
    Text
"fr" -> [Char]
localesDirectory [Char] -> [Char] -> [Char]
</> [Char]
"fr" [Char] -> [Char] -> [Char]
</> (SourceData -> [Char]
sourceFile SourceData
sdata) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".yml"
    Text
oth -> [Char]
localesDirectory [Char] -> [Char] -> [Char]
</> (Text -> [Char]
unpack Text
oth [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".yml")

getSourceFile :: (MonadThrow m, MonadIO m) => FilePath -> m FilePath
getSourceFile :: forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
[Char] -> m [Char]
getSourceFile [Char]
fname = do
  [Char]
fname' <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getDataFileName [Char]
fname
  Bool
exist <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fname'
  if Bool
exist
    then [Char] -> m [Char]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
fname'
    else FakerException -> m [Char]
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FakerException -> m [Char]) -> FakerException -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> FakerException
InvalidLocale [Char]
fname'

fetchData ::
     (MonadThrow m, MonadIO m)
  => FakerSettings
  -> SourceData
  -> (FakerSettings -> Value -> Parser a)
  -> m a
fetchData :: forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
FakerSettings
-> SourceData -> (FakerSettings -> Value -> Parser a) -> m a
fetchData FakerSettings
settings SourceData
sdata FakerSettings -> Value -> Parser a
parser = do
  let locale :: Text
locale = FakerSettings -> Text
getLocale FakerSettings
settings
      fname :: [Char]
fname = SourceData -> Text -> [Char]
guessSourceFile SourceData
sdata Text
locale
      ckey :: CacheFileKey
ckey = CacheFileKey {cfkSource :: SourceData
cfkSource = SourceData
sdata, cfkLocale :: Text
cfkLocale = Text
locale}
  HashMap CacheFileKey Value
cache <- IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value))
-> IO (HashMap CacheFileKey Value)
-> m (HashMap CacheFileKey Value)
forall a b. (a -> b) -> a -> b
$ FakerSettings -> IO (HashMap CacheFileKey Value)
getCacheFile FakerSettings
settings
  case (CacheFileKey -> HashMap CacheFileKey Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup CacheFileKey
ckey HashMap CacheFileKey Value
cache) of
    Maybe Value
Nothing -> do
      [Char]
afile <- [Char] -> m [Char]
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
[Char] -> m [Char]
getSourceFile [Char]
fname
      ByteString
bs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
afile
      Value
yaml <- ByteString -> m Value
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow ByteString
bs
      let nhash :: HashMap CacheFileKey Value
nhash = CacheFileKey
-> Value
-> HashMap CacheFileKey Value
-> HashMap CacheFileKey Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert CacheFileKey
ckey Value
yaml HashMap CacheFileKey Value
cache
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HashMap CacheFileKey Value -> FakerSettings -> IO ()
setCacheFile HashMap CacheFileKey Value
nhash FakerSettings
settings
      ([Char] -> m a) -> (a -> m a) -> Either [Char] a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FakerException -> m a)
-> ([Char] -> FakerException) -> [Char] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FakerException
ParseError) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser a) -> Value -> Either [Char] a
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither (FakerSettings -> Value -> Parser a
parser FakerSettings
settings) Value
yaml)
    Just Value
yaml ->
      ([Char] -> m a) -> (a -> m a) -> Either [Char] a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FakerException -> m a)
-> ([Char] -> FakerException) -> [Char] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FakerException
ParseError) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser a) -> Value -> Either [Char] a
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither (FakerSettings -> Value -> Parser a
parser FakerSettings
settings) Value
yaml)

fetchDataSingle ::
     (MonadThrow m, MonadIO m)
  => FakerSettings
  -> SourceData
  -> (FakerSettings -> Value -> Parser Text)
  -> m (Vector Text)
fetchDataSingle :: forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FakerSettings
-> SourceData
-> (FakerSettings -> Value -> Parser Text)
-> m (Vector Text)
fetchDataSingle FakerSettings
settings SourceData
sdata FakerSettings -> Value -> Parser Text
parser = do
  let locale :: Text
locale = FakerSettings -> Text
getLocale FakerSettings
settings
      fname :: [Char]
fname = SourceData -> Text -> [Char]
guessSourceFile SourceData
sdata Text
locale
      ckey :: CacheFileKey
ckey = CacheFileKey {cfkSource :: SourceData
cfkSource = SourceData
sdata, cfkLocale :: Text
cfkLocale = Text
locale}
  HashMap CacheFileKey Value
cache <- IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value))
-> IO (HashMap CacheFileKey Value)
-> m (HashMap CacheFileKey Value)
forall a b. (a -> b) -> a -> b
$ FakerSettings -> IO (HashMap CacheFileKey Value)
getCacheFile FakerSettings
settings
  case (CacheFileKey -> HashMap CacheFileKey Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup CacheFileKey
ckey HashMap CacheFileKey Value
cache) of
    Maybe Value
Nothing -> do
      [Char]
afile <- [Char] -> m [Char]
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
[Char] -> m [Char]
getSourceFile [Char]
fname
      ByteString
bs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile [Char]
afile
      Value
yaml <- ByteString -> m Value
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow ByteString
bs
      let nhash :: HashMap CacheFileKey Value
nhash = CacheFileKey
-> Value
-> HashMap CacheFileKey Value
-> HashMap CacheFileKey Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert CacheFileKey
ckey Value
yaml HashMap CacheFileKey Value
cache
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HashMap CacheFileKey Value -> FakerSettings -> IO ()
setCacheFile HashMap CacheFileKey Value
nhash FakerSettings
settings
      Text -> Vector Text
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Vector Text) -> m Text -> m (Vector Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ([Char] -> m Text)
-> (Text -> m Text) -> Either [Char] Text -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m Text
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FakerException -> m Text)
-> ([Char] -> FakerException) -> [Char] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FakerException
ParseError) Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser Text) -> Value -> Either [Char] Text
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither (FakerSettings -> Value -> Parser Text
parser FakerSettings
settings) Value
yaml)
    Just Value
yaml ->
      Text -> Vector Text
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Vector Text) -> m Text -> m (Vector Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ([Char] -> m Text)
-> (Text -> m Text) -> Either [Char] Text -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m Text
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FakerException -> m Text)
-> ([Char] -> FakerException) -> [Char] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FakerException
ParseError) Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser Text) -> Value -> Either [Char] Text
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither (FakerSettings -> Value -> Parser Text
parser FakerSettings
settings) Value
yaml)