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

-- λ> runQ [d|state :: Fake Text;state = Fake (resolver stateProvider)|]
-- [SigD state_0 (AppT (ConT Faker.Fake) (ConT Data.Text.Internal.Text)),ValD (VarP state_0) (NormalB (AppE (ConE Faker.Fake) (AppE (VarE Faker.Internal.resolver) (VarE Faker.Provider.Address.stateProvider)))) []]
-- $(genrateFakeField "address" "state")
-- The above splice will generate a function named state
-- Assumes the presence of the function named "addressStateProvider"
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))))
        []
    ]

-- λ> runQ runQ [d|community :: Fake Text; community = Fake (cachedRandomUnresolvedVec "address" "community" communityProvider resolveAddressField)|]
-- [SigD community_1 (AppT (ConT Faker.Fake) (ConT Data.Text.Internal.Text)),ValD (VarP community_1) (NormalB (AppE (ConE Faker.Fake) (AppE (AppE (AppE (AppE (VarE Faker.Internal.cachedRandomUnresolvedVec) (LitE (StringL "address"))) (LitE (StringL "community"))) (VarE Faker.Provider.Address.communityProvider)) (VarE Faker.Provider.Address.resolveAddressField)))) []]
-- $(genrateFakeFieldUnresolved "address" "comunity")
-- The above splice will generate a function named state
-- Assumes the presence of the function named "addressStateProvider" and "resolveAddressText"
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))))
        []
    ]