{-# 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

-- λ> runQ [d| parseBeerName :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a; parseBeerName settings = parseBeerField settings "name"|]
-- [SigD parseBeerName_1 (ForallT [] [AppT (ConT Data.Aeson.Types.FromJSON.FromJSON) (VarT a_0),AppT (ConT GHC.Base.Monoid) (VarT a_0)] (AppT (AppT ArrowT (ConT Faker.FakerSettings)) (AppT (AppT ArrowT (ConT Data.Aeson.Types.Internal.Value)) (AppT (ConT Data.Aeson.Types.Internal.Parser) (VarT a_0))))),FunD parseBeerName_1 [Clause [VarP settings_2] (NormalB (AppE (AppE (VarE Faker.Provider.Beer.parseBeerField) (VarE settings_2)) (LitE (StringL "name")))) []]]
-- λ
-- $(genParser "beer" "name")
-- The above code will produce a function named 'parseBeerName'
-- parseBeerName :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser a
-- Note that a function named parseBeerField should be present in the scope for this to work.
genParser ::
     Text -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> Text -- ^ Field name within the entity.
  -> 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 -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> [Text] -- ^ Field name within the entity.
  -> 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 -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> [Text] -- ^ Field name within the entity.
  -> 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 -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> [Text] -- ^ Field name within the entity.
  -> Q [Dec]
genProvidersSingle :: Text -> [Text] -> Q [Dec]
genProvidersSingle 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 -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> [Text] -- ^ Field name within the entity.
  -> Q [Dec]
genProvidersSingleUnresolved :: Text -> [Text] -> Q [Dec]
genProvidersSingleUnresolved 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))))) -- come here
    , 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)))
            []
        ]
    ]

-- λ> runQ [d|beerNameProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Vector Text); beerNameProvider settings = fetchData settings Beer parseBeerName|]
-- [SigD beerNameProvider_1 (ForallT [] [AppT (ConT Control.Monad.Catch.MonadThrow) (VarT m_0),AppT (ConT Control.Monad.IO.Class.MonadIO) (VarT m_0)] (AppT (AppT ArrowT (ConT Faker.FakerSettings)) (AppT (VarT m_0) (AppT (ConT Data.Vector.Vector) (ConT Data.Text.Internal.Text))))),FunD beerNameProvider_1 [Clause [VarP settings_2] (NormalB (AppE (AppE (AppE (VarE Config.fetchData) (VarE settings_2)) (ConE Config.Beer)) (VarE Faker.Provider.Beer.parseBeerName))) []]]
-- $(genProvider "beer" "name")
-- This will produce a function named: "beerNameProvider"
-- Assumes the presence of parseBeerName function in the scope.
genProvider ::
     Text -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> Text -- ^ Field name within the entity.
  -> 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)))
            []
        ]
    ]

-- λ> runQ [d|parseVersionApp :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser (Unresolved a); parseVersionApp settings = parseUnresolvedAppField settings "version"|]
-- [SigD parseVersionApp_1 (ForallT [] [AppT (ConT Data.Aeson.Types.FromJSON.FromJSON) (VarT a_0),AppT (ConT GHC.Base.Monoid) (VarT a_0)] (AppT (AppT ArrowT (ConT Faker.FakerSettings)) (AppT (AppT ArrowT (ConT Data.Aeson.Types.Internal.Value)) (AppT (ConT Data.Aeson.Types.Internal.Parser) (AppT (ConT Faker.Internal.Unresolved) (VarT a_0)))))),FunD parseVersionApp_1 [Clause [VarP settings_2] (NormalB (AppE (AppE (VarE Faker.Provider.App.parseUnresolvedAppField) (VarE settings_2)) (LitE (StringL "version")))) []]]
-- $(genParserUnresolved "app" "version")
-- This will generate a function named parseAppVersionUnresolved :: (FromJSON a, Monoid a) => FakerSettings -> Value -> Parser (Unresolved a)
-- This function assumes that parseUnresolvedAppField function is available in the scope.
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 -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> [Text] -- ^ Field name within the entity.
  -> 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)))
            []
        ]
    ]

-- λ> runQ [d|versionAppProvider :: (MonadThrow m, MonadIO m) => FakerSettings -> m (Unresolved (Vector Text)); versionAppProvider settings = fetchData settings App parseVersionApp|]
-- [SigD versionAppProvider_1 (ForallT [] [AppT (ConT Control.Monad.Catch.MonadThrow) (VarT m_0),AppT (ConT Control.Monad.IO.Class.MonadIO) (VarT m_0)] (AppT (AppT ArrowT (ConT Faker.FakerSettings)) (AppT (VarT m_0) (AppT (ConT Faker.Internal.Unresolved) (AppT (ConT Data.Vector.Vector) (ConT Data.Text.Internal.Text)))))),FunD versionAppProvider_1 [Clause [VarP settings_2] (NormalB (AppE (AppE (AppE (VarE Config.fetchData) (VarE settings_2)) (ConE Config.App)) (VarE Faker.Provider.App.parseVersionApp))) []]]
-- $(genProvider "beer" "name")
-- This will produce a function named: "beerNameProvider"
-- Assumes the presence of parseBeerNameUnresolved function in the scope.
genProviderUnresolved ::
     Text -- ^ Entity name. Example: animal, beer etc. This should be always lowercase.
  -> Text -- ^ Field name within the entity.
  -> 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"