37 lines
1.1 KiB
Haskell
37 lines
1.1 KiB
Haskell
module Database.Persist.TH.Directory
|
|
( persistDirectoryWith
|
|
) where
|
|
|
|
import ClassyPrelude
|
|
|
|
import Database.Persist.TH (parseReferences)
|
|
import Database.Persist.Quasi (PersistSettings)
|
|
import Language.Haskell.TH.Syntax hiding (lift)
|
|
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.IO as Text
|
|
import qualified System.IO as SIO
|
|
|
|
import System.FilePath
|
|
import qualified System.Directory.Tree as DirTree
|
|
|
|
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
|
|
|
|
import Control.Lens
|
|
|
|
|
|
persistDirectoryWith :: PersistSettings -> FilePath -> Q Exp
|
|
persistDirectoryWith settings dir = do
|
|
files <- runIO . flip DirTree.readDirectoryWith dir $ \fp -> runMaybeT $ do
|
|
fn <- MaybeT . return . fromNullable $ takeFileName fp
|
|
guard . not $ head fn == '.'
|
|
guard . not $ head fn == '#' && last fn == '#'
|
|
|
|
lift $ do
|
|
h <- SIO.openFile fp SIO.ReadMode
|
|
SIO.hSetEncoding h SIO.utf8_bom
|
|
Text.hGetContents h
|
|
mapM_ qAddDependentFile . toListOf (traverse . filtered (has $ _2 . _Just) . _1) $ DirTree.zipPaths files
|
|
|
|
parseReferences settings . Text.intercalate "\n" . toListOf (traverse . _Just) $ DirTree.dirTree files
|