{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Faker.Provider.TH where
import Config
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Char (toUpper)
import Data.Map.Strict (Map)
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Data.Vector (Vector)
import Data.Yaml
import Faker
import Faker.Internal
import Language.Haskell.TH
textTitle :: Text -> Text
textTitle :: Text -> Text
textTitle Text
txt =
case Text -> Maybe (Char, Text)
T.uncons Text
txt of
Maybe (Char, Text)
Nothing -> Text
txt
Just (Char
c, Text
rem) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
c) Text
rem
genParser ::
Text
-> Text
-> Q [Dec]
genParser :: Text -> Text -> Q [Dec]
genParser Text
entityName Text
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName)
let parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Field"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
let tvA :: Name
tvA = String -> Name
mkName String
"a"
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[Type -> Type -> Type
AppT (Name -> Type
ConT ''FromJSON) (Name -> Type
VarT Name
tvA), Type -> Type -> Type
AppT (Name -> Type
ConT ''Monoid) (Name -> Type
VarT Name
tvA)]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''Value))
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Parser) (Name -> Type
VarT Name
tvA)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
parserFn) (Name -> Exp
VarE Name
tsettings))
(Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
fieldName)))))
[]
]
]
genParsers ::
Text
-> [Text]
-> Q [Dec]
genParsers :: Text -> [Text] -> Q [Dec]
genParsers Text
entityName [Text]
fieldName = do
let fieldNames :: [Text]
fieldNames = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldName
fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
fieldNames
funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
fieldNames')
let parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Fields"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
let tvA :: Name
tvA = String -> Name
mkName String
"a"
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[Type -> Type -> Type
AppT (Name -> Type
ConT ''FromJSON) (Name -> Type
VarT Name
tvA), Type -> Type -> Type
AppT (Name -> Type
ConT ''Monoid) (Name -> Type
VarT Name
tvA)]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''Value))
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Parser) (Name -> Type
VarT Name
tvA)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
parserFn) (Name -> Exp
VarE Name
tsettings))
([Exp] -> Exp
ListE ((Text -> Exp) -> [Text] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
x))) [Text]
fieldName))))
[]
]
]
genProviders ::
Text
-> [Text]
-> Q [Dec]
genProviders :: Text -> [Text] -> Q [Dec]
genProviders Text
entityName [Text]
fieldName = do
let fieldNames :: [Text]
fieldNames = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldName
fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
fieldNames
funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text -> Text
refinedText Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames'
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT (Name -> Type
VarT Name
tvM) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Vector) (Name -> Type
ConT ''Text)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchData) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genProvidersSingle ::
Text
-> [Text]
-> Q [Dec]
Text
entityName [Text]
fieldName = do
let fieldNames :: [Text]
fieldNames = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldName
fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
fieldNames
funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text -> Text
refinedText Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames'
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT (Name -> Type
VarT Name
tvM) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Vector) (Name -> Type
ConT ''Text)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchDataSingle) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genProvidersSingleUnresolved ::
Text
-> [Text]
-> Q [Dec]
Text
entityName [Text]
fieldName = do
let fieldNames :: [Text]
fieldNames = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldName
fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
fieldNames
funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text -> Text
refinedText Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Unresolved"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT (Name -> Type
VarT Name
tvM) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Name -> Type
ConT ''Text)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchData) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genProvider ::
Text
-> Text
-> Q [Dec]
genProvider :: Text -> Text -> Q [Dec]
genProvider Text
entityName Text
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
(Text -> Text
refinedText Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName)
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT (Name -> Type
VarT Name
tvM) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Vector) (Name -> Type
ConT ''Text)))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchData) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genParserUnresolved :: Text -> Text -> Q [Dec]
genParserUnresolved :: Text -> Text -> Q [Dec]
genParserUnresolved Text
entityName Text
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Unresolved"
let parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parseUnresolved" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Field"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
let tvA :: Name
tvA = String -> Name
mkName String
"a"
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[Type -> Type -> Type
AppT (Name -> Type
ConT ''FromJSON) (Name -> Type
VarT Name
tvA), Type -> Type -> Type
AppT (Name -> Type
ConT ''Monoid) (Name -> Type
VarT Name
tvA)]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''Value))
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Parser) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Name -> Type
VarT Name
tvA))))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
parserFn) (Name -> Exp
VarE Name
tsettings))
(Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
fieldName)))))
[]
]
]
genParserSingleUnresolved :: Text -> Text -> Q [Dec]
genParserSingleUnresolved :: Text -> Text -> Q [Dec]
genParserSingleUnresolved Text
entityName Text
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Unresolved"
let parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parseUnresolved" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Field"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
let tvA :: Name
tvA = String -> Name
mkName String
"a"
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''Value))
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Parser) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Name -> Type
ConT ''Text))))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
parserFn) (Name -> Exp
VarE Name
tsettings))
(Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
fieldName)))))
[]
]
]
genParserUnresolveds :: Text -> [Text] -> Q [Dec]
genParserUnresolveds :: Text -> [Text] -> Q [Dec]
genParserUnresolveds Text
entityName [Text]
fieldNames = do
let fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldNames
funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Unresolved"
let parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parseUnresolved" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Fields"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
let tvA :: Name
tvA = String -> Name
mkName String
"a"
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[Type -> Type -> Type
AppT (Name -> Type
ConT ''FromJSON) (Name -> Type
VarT Name
tvA), Type -> Type -> Type
AppT (Name -> Type
ConT ''Monoid) (Name -> Type
VarT Name
tvA)]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''Value))
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Parser) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Name -> Type
VarT Name
tvA))))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
parserFn) (Name -> Exp
VarE Name
tsettings))
([Exp] -> Exp
ListE ((Text -> Exp) -> [Text] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Lit -> Exp
LitE (String -> Lit
StringL (Text -> String
unpack Text
x))) [Text]
fieldNames))))
[]
]
]
genProviderUnresolveds ::
Text
-> [Text]
-> Q [Dec]
genProviderUnresolveds :: Text -> [Text] -> Q [Dec]
genProviderUnresolveds Text
entityName [Text]
fieldNames = do
let fieldNames' :: Text
fieldNames' = Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
textTitle [Text]
fieldNames
entityName' :: Text
entityName' = Text -> Text
refinedText Text
entityName
funName :: Name
funName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
entityName' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
textTitle Text
entityName') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldNames' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Unresolved"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Name -> Type
VarT Name
tvM)
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Vector) (Name -> Type
ConT ''Text))))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchData) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genProviderUnresolved ::
Text
-> Text
-> Q [Dec]
genProviderUnresolved :: Text -> Text -> Q [Dec]
genProviderUnresolved Text
entityName Text
fieldName = do
let funName :: Name
funName =
String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
entityName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
textTitle Text
fieldName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Provider"
tvM :: Name
tvM = String -> Name
mkName String
"m"
parserFnName :: String
parserFnName =
Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"parse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Text
refinedText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
textTitle Text
fieldName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Unresolved"
Maybe Name
parserName <- String -> Q (Maybe Name)
lookupValueName String
parserFnName
Name
parserFn <-
case Maybe Name
parserName 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
"Faker.TH: Didn't find function " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parserFnName
Just Name
fn -> Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
Name
tsettings <- String -> Q Name
newName String
"settings"
[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
([TyVarBndr] -> Cxt -> Type -> Type
ForallT
[]
[ Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadThrow) (Name -> Type
VarT Name
tvM)
, Type -> Type -> Type
AppT (Name -> Type
ConT ''MonadIO) (Name -> Type
VarT Name
tvM)
]
(Type -> Type -> Type
AppT
(Type -> Type -> Type
AppT Type
ArrowT (Name -> Type
ConT ''FakerSettings))
(Type -> Type -> Type
AppT
(Name -> Type
VarT Name
tvM)
(Type -> Type -> Type
AppT (Name -> Type
ConT ''Unresolved) (Type -> Type -> Type
AppT (Name -> Type
ConT ''Vector) (Name -> Type
ConT ''Text))))))
, Name -> [Clause] -> Dec
FunD
Name
funName
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
tsettings]
(Exp -> Body
NormalB
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE
(Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'fetchData) (Name -> Exp
VarE Name
tsettings))
(Name -> Exp
ConE (Text -> Name
mapSource Text
entityName)))
(Name -> Exp
VarE Name
parserFn)))
[]
]
]
genAppParser :: Text -> Q [Dec]
genAppParser :: Text -> Q [Dec]
genAppParser = Text -> Text -> Q [Dec]
genParser Text
"app"
genAppProvider :: Text -> Q [Dec]
genAppProvider :: Text -> Q [Dec]
genAppProvider = Text -> Text -> Q [Dec]
genProvider Text
"app"
genAppParserUnresolved :: Text -> Q [Dec]
genAppParserUnresolved :: Text -> Q [Dec]
genAppParserUnresolved = Text -> Text -> Q [Dec]
genParserUnresolved Text
"app"
genAppProviderUnresolved :: Text -> Q [Dec]
genAppProviderUnresolved :: Text -> Q [Dec]
genAppProviderUnresolved = Text -> Text -> Q [Dec]
genProviderUnresolved Text
"app"