{-# 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 :: FilePath
localesDirectory = FilePath
"faker/lib/locales"

localesEnDirectory :: FilePath
localesEnDirectory :: FilePath
localesEnDirectory = FilePath
"faker/lib/locales/en"

localesCustomEnDirectory :: FilePath
localesCustomEnDirectory :: FilePath
localesCustomEnDirectory = FilePath
"customFakeSource/en"

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

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

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

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

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

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

fetchData ::
     (MonadThrow m, MonadIO m)
  => FakerSettings
  -> SourceData
  -> (FakerSettings -> Value -> Parser a)
  -> m a
fetchData :: 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 :: FilePath
fname = SourceData -> Text -> FilePath
guessSourceFile SourceData
sdata Text
locale
      ckey :: CacheFileKey
ckey = CacheFileKey :: SourceData -> Text -> CacheFileKey
CacheFileKey {cfkSource :: SourceData
cfkSource = SourceData
sdata, cfkLocale :: Text
cfkLocale = Text
locale}
  HashMap CacheFileKey Value
cache <- IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value)
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
      FilePath
afile <- FilePath -> m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> m FilePath
getSourceFile FilePath
fname
      ByteString
bs <- IO ByteString -> m ByteString
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
$ FilePath -> IO ByteString
BS.readFile FilePath
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 (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
      (FilePath -> m a) -> (a -> m a) -> Either FilePath a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FakerException -> m a)
-> (FilePath -> FakerException) -> FilePath -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FakerException
ParseError) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser a) -> Value -> Either FilePath a
forall a b. (a -> Parser b) -> a -> Either FilePath b
parseEither (FakerSettings -> Value -> Parser a
parser FakerSettings
settings) Value
yaml)
    Just Value
yaml ->
      (FilePath -> m a) -> (a -> m a) -> Either FilePath a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FakerException -> m a)
-> (FilePath -> FakerException) -> FilePath -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FakerException
ParseError) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser a) -> Value -> Either FilePath a
forall a b. (a -> Parser b) -> a -> Either FilePath 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 :: 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 :: FilePath
fname = SourceData -> Text -> FilePath
guessSourceFile SourceData
sdata Text
locale
      ckey :: CacheFileKey
ckey = CacheFileKey :: SourceData -> Text -> CacheFileKey
CacheFileKey {cfkSource :: SourceData
cfkSource = SourceData
sdata, cfkLocale :: Text
cfkLocale = Text
locale}
  HashMap CacheFileKey Value
cache <- IO (HashMap CacheFileKey Value) -> m (HashMap CacheFileKey Value)
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
      FilePath
afile <- FilePath -> m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> m FilePath
getSourceFile FilePath
fname
      ByteString
bs <- IO ByteString -> m ByteString
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
$ FilePath -> IO ByteString
BS.readFile FilePath
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 (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 (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
<$>
        (FilePath -> m Text)
-> (Text -> m Text) -> Either FilePath Text -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FakerException -> m Text)
-> (FilePath -> FakerException) -> FilePath -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FakerException
ParseError) Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser Text) -> Value -> Either FilePath Text
forall a b. (a -> Parser b) -> a -> Either FilePath b
parseEither (FakerSettings -> Value -> Parser Text
parser FakerSettings
settings) Value
yaml)
    Just Value
yaml ->
      Text -> Vector Text
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
<$>
      (FilePath -> m Text)
-> (Text -> m Text) -> Either FilePath Text -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FakerException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FakerException -> m Text)
-> (FilePath -> FakerException) -> FilePath -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FakerException
ParseError) Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value -> Parser Text) -> Value -> Either FilePath Text
forall a b. (a -> Parser b) -> a -> Either FilePath b
parseEither (FakerSettings -> Value -> Parser Text
parser FakerSettings
settings) Value
yaml)