{-# 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 :: String -> String
stringTitle [] = []
stringTitle (Char
x:String
xs) = (Char -> Char
toUpper Char
x) Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
lowerTitle :: String -> String
lowerTitle :: String -> String
lowerTitle [] = []
lowerTitle (Char
x:String
xs) = (Char -> Char
toLower Char
x) Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
generateFakeField :: String -> String -> Q [Dec]
generateFakeField :: String -> String -> Q [Dec]
generateFakeField String
entityName String
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
case String -> String
refinedString String
fieldName of
String
"type" -> String
"type'"
String
other -> String
other
pfn :: String
pfn = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
entityName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
stringTitle String
fieldName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provider"
Maybe Name
providerName <- String -> Q (Maybe Name)
lookupValueName String
pfn
Name
providerFn <-
case Maybe Name
providerName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"generateFakefield: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Type -> Dec
SigD Name
funName (Type -> Type -> Type
AppT (Name -> Type
ConT ''Fake) (Name -> Type
ConT ''Text))
, Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
funName)
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Name -> Exp
ConE 'Fake)
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'cachedRandomVec) (Lit -> Exp
LitE (String -> Lit
StringL String
entityName)))
(Lit -> Exp
LitE (String -> Lit
StringL String
fieldName)))
(Name -> Exp
VarE Name
providerFn))))
[]
]
generateFakeFields :: String -> [String] -> Q [Dec]
generateFakeFields :: String -> [String] -> Q [Dec]
generateFakeFields String
entityName [String]
fieldName = do
let fieldName' :: [String]
fieldName' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
stringTitle [String]
fieldName
fieldName'' :: String
fieldName'' = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
fieldName'
pfn :: String
pfn = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
entityName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fieldName'' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provider"
funNameString :: String
funNameString = String -> String
lowerTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
refinedString String
fieldName''
funName :: Name
funName = String -> Name
mkName String
funNameString
Maybe Name
providerName <- String -> Q (Maybe Name)
lookupValueName String
pfn
Name
providerFn <-
case Maybe Name
providerName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"generateFakefields: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Type -> Dec
SigD Name
funName (Type -> Type -> Type
AppT (Name -> Type
ConT ''Fake) (Name -> Type
ConT ''Text))
, Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
funName)
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Name -> Exp
ConE 'Fake)
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'cachedRandomVec) (Lit -> Exp
LitE (String -> Lit
StringL String
entityName)))
(Lit -> Exp
LitE (String -> Lit
StringL String
funNameString)))
(Name -> Exp
VarE Name
providerFn))))
[]
]
generateFakeFieldUnresolved :: String -> String -> Q [Dec]
generateFakeFieldUnresolved :: String -> String -> Q [Dec]
generateFakeFieldUnresolved String
entityName String
fieldName = do
let funName :: Name
funName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
refinedString String
fieldName
pfn :: String
pfn = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
entityName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
stringTitle String
fieldName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provider"
rfn :: String
rfn = String
"resolve" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
stringTitle String
entityName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Text"
Maybe Name
providerName <- String -> Q (Maybe Name)
lookupValueName String
pfn
Maybe Name
resolverName <- String -> Q (Maybe Name)
lookupValueName String
rfn
Name
providerFn <-
case Maybe Name
providerName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolved: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
resolverFn <-
case Maybe Name
resolverName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolved: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Type -> Dec
SigD Name
funName (Type -> Type -> Type
AppT (Name -> Type
ConT ''Fake) (Name -> Type
ConT ''Text))
, Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
funName)
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Name -> Exp
ConE 'Fake)
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Name -> Exp
VarE 'cachedRandomUnresolvedVec)
(Lit -> Exp
LitE (String -> Lit
StringL String
entityName)))
(Lit -> Exp
LitE (String -> Lit
StringL String
fieldName)))
(Name -> Exp
VarE Name
providerFn))
(Name -> Exp
VarE Name
resolverFn))))
[]
]
generateFakeFieldSingleUnresolved :: String -> String -> Q [Dec]
generateFakeFieldSingleUnresolved :: String -> String -> Q [Dec]
generateFakeFieldSingleUnresolved String
entityName String
fieldName = do
let funName :: Name
funName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> String
refinedString String
fieldName
pfn :: String
pfn = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
entityName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
stringTitle String
fieldName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provider"
rfn :: String
rfn = String
"resolve" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
stringTitle String
entityName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Text"
Maybe Name
providerName <- String -> Q (Maybe Name)
lookupValueName String
pfn
Maybe Name
resolverName <- String -> Q (Maybe Name)
lookupValueName String
rfn
Name
providerFn <-
case Maybe Name
providerName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolved: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
resolverFn <-
case Maybe Name
resolverName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolved: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Type -> Dec
SigD Name
funName (Type -> Type -> Type
AppT (Name -> Type
ConT ''Fake) (Name -> Type
ConT ''Text))
, Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
funName)
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Name -> Exp
ConE 'Fake)
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Name -> Exp
VarE 'cachedRandomUnresolvedVecWithoutVector)
(Lit -> Exp
LitE (String -> Lit
StringL String
entityName)))
(Lit -> Exp
LitE (String -> Lit
StringL String
fieldName)))
(Name -> Exp
VarE Name
providerFn))
(Name -> Exp
VarE Name
resolverFn))))
[]
]
generateFakeFieldUnresolveds :: String -> [String] -> Q [Dec]
generateFakeFieldUnresolveds :: String -> [String] -> Q [Dec]
generateFakeFieldUnresolveds String
entityName [String]
fieldNames = do
let fieldName' :: String
fieldName' = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
stringTitle [String]
fieldNames
funNameString :: String
funNameString = String -> String
lowerTitle String
fieldName'
funName :: Name
funName = String -> Name
mkName String
funNameString
pfn :: String
pfn = String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
entityName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fieldName' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provider"
rfn :: String
rfn = String
"resolve" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String
refinedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
stringTitle String
entityName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Text"
Maybe Name
providerName <- String -> Q (Maybe Name)
lookupValueName String
pfn
Maybe Name
resolverName <- String -> Q (Maybe Name)
lookupValueName String
rfn
Name
providerFn <-
case Maybe Name
providerName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolveds: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
resolverFn <-
case Maybe Name
resolverName of
Maybe Name
Nothing ->
String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$
String
"generateFakeFieldUnresolveds: Function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rfn String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" not found in scope"
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Type -> Dec
SigD Name
funName (Type -> Type -> Type
AppT (Name -> Type
ConT ''Fake) (Name -> Type
ConT ''Text))
, Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
funName)
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Name -> Exp
ConE 'Fake)
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Name -> Exp
VarE 'cachedRandomUnresolvedVec)
(Lit -> Exp
LitE (String -> Lit
StringL String
entityName)))
(Lit -> Exp
LitE (String -> Lit
StringL String
funNameString)))
(Name -> Exp
VarE Name
providerFn))
(Name -> Exp
VarE Name
resolverFn))))
[]
]