{-# LANGUAGE CPP #-}

-- |
--
-- @since 0.1.0.0
module Database.Persist.Discover
    ( findPersistentModelFiles
    ) where

import Database.Persist.Discover.Exe (getFilesRecursive, stripSuffix)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Data.FileEmbed

-- | Returns a list of all files with the @.persistentmodels@ suffix.
--
-- > allFiles :: [FilePath]
-- > allFiles = $$(findPersistentModelFiles "config/models/")
--
-- @since 0.1.0.0
findPersistentModelFiles
    :: FilePath
    -- ^ The root directory to search from.
    -> Q (TExp [FilePath])
findPersistentModelFiles :: FilePath -> Q (TExp [FilePath])
findPersistentModelFiles FilePath
root = do
    FilePath
projectRoot <- FilePath -> Q FilePath
makeRelativeToProject FilePath
root
    [FilePath]
files <- IO [FilePath] -> Q [FilePath]
forall a. IO a -> Q a
runIO (IO [FilePath] -> Q [FilePath]) -> IO [FilePath] -> Q [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isPersistentModelFile ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getFilesRecursive FilePath
projectRoot
#if MIN_VERSION_template_haskell(2,17,0)
    examineCode $ liftTyped files
#else
    [FilePath] -> Q (TExp [FilePath])
forall t. Lift t => t -> Q (TExp t)
liftTyped [FilePath]
files
#endif
  where
    isPersistentModelFile :: FilePath -> Bool
isPersistentModelFile FilePath
filename =
        case FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
".persistentmodels" FilePath
filename of
            Just FilePath
_ ->
                Bool
True
            Maybe FilePath
_ ->
                Bool
False