module Rivet.TH where
import qualified Data.Foldable as F
import Data.List
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import System.Directory.Tree
import System.FilePath
type FileData = (String, String)
type DirData = FilePath
loadFile :: String -> FilePath -> Q [Dec]
loadFile nm pth = do let ident = mkName nm
typeSig <- SigD ident `fmap` [t| String |]
v <- valD (varP ident) (normalB $ lift =<< runIO (readFile pth)) []
return [typeSig, v]
loadProjectTemplate :: Q [Dec]
loadProjectTemplate = do let dir = mkName "tDirTemplate"
typeSig <- SigD dir `fmap` [t| ([String], [(String, String)]) |]
v <- valD (varP dir) (normalB $ dirQ ("template" </> "project")) []
return [typeSig, v]
loadModelTemplate :: Q [Dec]
loadModelTemplate = do let dir = mkName "tModelTemplate"
typeSig <- SigD dir `fmap` [t| ([String], [(String, String)]) |]
v <- valD (varP dir) (normalB $ dirQ ("template" </> "model")) []
return [typeSig, v]
getDirs :: [FilePath] -> DirTree a -> [FilePath]
getDirs prefix (Dir n c) = (intercalate "/" (reverse (n:prefix))) :
concatMap (getDirs (n:prefix)) c
getDirs _ (File _ _) = []
getDirs _ (Failed _ _) = []
readTree :: FilePath -> IO ([DirData], [FileData])
readTree dir = do d <- readDirectory $ dir </> "."
let ps = zipPaths $ "" :/ (dirTree d)
fd = F.foldr (:) [] ps
dirs = getDirs [] $ dirTree d
return (drop 1 dirs, fd)
dirQ :: FilePath -> Q Exp
dirQ tplDir = do d <- runIO . readTree $ tplDir
lift d