{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Faker.TH
( generateFakeField
, generateFakeFields
, generateFakeFieldUnresolved
, generateFakeFieldSingleUnresolved
, generateFakeFieldUnresolveds
) where
import Config
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Char (toLower, toUpper)
import Data.Map.Strict (Map)
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import Data.Vector (Vector)
import Data.Yaml
import Faker
import Faker.Internal
import Language.Haskell.TH
stringTitle :: String -> String
stringTitle [] = []
stringTitle (x:xs) = (toUpper x) : xs
lowerTitle :: String -> String
lowerTitle [] = []
lowerTitle (x:xs) = (toLower x) : xs
generateFakeField :: String -> String -> Q [Dec]
generateFakeField entityName fieldName = do
let funName =
mkName $
case refinedString fieldName of
"type" -> "type'"
other -> other
pfn = refinedString $ entityName <> (stringTitle fieldName) <> "Provider"
providerName <- lookupValueName pfn
providerFn <-
case providerName of
Nothing ->
fail $ "generateFakefield: Function " <> pfn <> " not found in scope"
Just fn -> return fn
return $
[ SigD funName (AppT (ConT ''Fake) (ConT ''Text))
, ValD
(VarP funName)
(NormalB
(AppE
(ConE 'Fake)
(AppE
(AppE
(AppE (VarE 'cachedRandomVec) (LitE (StringL entityName)))
(LitE (StringL fieldName)))
(VarE providerFn))))
[]
]
generateFakeFields :: String -> [String] -> Q [Dec]
generateFakeFields entityName fieldName = do
let fieldName' = map stringTitle fieldName
fieldName'' = concat fieldName'
pfn = refinedString $ entityName <> fieldName'' <> "Provider"
funNameString = lowerTitle $ refinedString fieldName''
funName = mkName funNameString
providerName <- lookupValueName pfn
providerFn <-
case providerName of
Nothing ->
fail $ "generateFakefields: Function " <> pfn <> " not found in scope"
Just fn -> return fn
return $
[ SigD funName (AppT (ConT ''Fake) (ConT ''Text))
, ValD
(VarP funName)
(NormalB
(AppE
(ConE 'Fake)
(AppE
(AppE
(AppE (VarE 'cachedRandomVec) (LitE (StringL entityName)))
(LitE (StringL funNameString)))
(VarE providerFn))))
[]
]
generateFakeFieldUnresolved :: String -> String -> Q [Dec]
generateFakeFieldUnresolved entityName fieldName = do
let funName = mkName $ refinedString fieldName
pfn = refinedString $ entityName <> (stringTitle fieldName) <> "Provider"
rfn = "resolve" <> (refinedString $ stringTitle entityName) <> "Text"
providerName <- lookupValueName pfn
resolverName <- lookupValueName rfn
providerFn <-
case providerName of
Nothing ->
fail $
"generateFakeFieldUnresolved: Function " <> pfn <> " not found in scope"
Just fn -> return fn
resolverFn <-
case resolverName of
Nothing ->
fail $
"generateFakeFieldUnresolved: Function " <> rfn <> " not found in scope"
Just fn -> return fn
return $
[ SigD funName (AppT (ConT ''Fake) (ConT ''Text))
, ValD
(VarP funName)
(NormalB
(AppE
(ConE 'Fake)
(AppE
(AppE
(AppE
(AppE
(VarE 'cachedRandomUnresolvedVec)
(LitE (StringL entityName)))
(LitE (StringL fieldName)))
(VarE providerFn))
(VarE resolverFn))))
[]
]
generateFakeFieldSingleUnresolved :: String -> String -> Q [Dec]
generateFakeFieldSingleUnresolved entityName fieldName = do
let funName = mkName $ refinedString fieldName
pfn = refinedString $ entityName <> (stringTitle fieldName) <> "Provider"
rfn = "resolve" <> (refinedString $ stringTitle entityName) <> "Text"
providerName <- lookupValueName pfn
resolverName <- lookupValueName rfn
providerFn <-
case providerName of
Nothing ->
fail $
"generateFakeFieldUnresolved: Function " <> pfn <> " not found in scope"
Just fn -> return fn
resolverFn <-
case resolverName of
Nothing ->
fail $
"generateFakeFieldUnresolved: Function " <> rfn <> " not found in scope"
Just fn -> return fn
return $
[ SigD funName (AppT (ConT ''Fake) (ConT ''Text))
, ValD
(VarP funName)
(NormalB
(AppE
(ConE 'Fake)
(AppE
(AppE
(AppE
(AppE
(VarE 'cachedRandomUnresolvedVecWithoutVector)
(LitE (StringL entityName)))
(LitE (StringL fieldName)))
(VarE providerFn))
(VarE resolverFn))))
[]
]
generateFakeFieldUnresolveds :: String -> [String] -> Q [Dec]
generateFakeFieldUnresolveds entityName fieldNames = do
let fieldName' = refinedString $ concat $ map stringTitle fieldNames
funNameString = lowerTitle fieldName'
funName = mkName funNameString
pfn = refinedString $ entityName <> fieldName' <> "Provider"
rfn = "resolve" <> (refinedString $ stringTitle entityName) <> "Text"
providerName <- lookupValueName pfn
resolverName <- lookupValueName rfn
providerFn <-
case providerName of
Nothing ->
fail $
"generateFakeFieldUnresolveds: Function " <> pfn <>
" not found in scope"
Just fn -> return fn
resolverFn <-
case resolverName of
Nothing ->
fail $
"generateFakeFieldUnresolveds: Function " <> rfn <>
" not found in scope"
Just fn -> return fn
return $
[ SigD funName (AppT (ConT ''Fake) (ConT ''Text))
, ValD
(VarP funName)
(NormalB
(AppE
(ConE 'Fake)
(AppE
(AppE
(AppE
(AppE
(VarE 'cachedRandomUnresolvedVec)
(LitE (StringL entityName)))
(LitE (StringL funNameString)))
(VarE providerFn))
(VarE resolverFn))))
[]
]