{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module YesodDsl.Generator (generate, hsRouteName, genFay) where import Prelude hiding (readFile) import System.IO (FilePath, writeFile) import System.IO.Strict (readFile) import System.FilePath (joinPath) import System.Directory (createDirectoryIfMissing) import Data.String.Utils (rstrip) import YesodDsl.AST import Text.Shakespeare.Text hiding (toText) import qualified Data.Text as T import Data.List import Data.Maybe import Control.Monad import Data.Char import YesodDsl.Generator.Models import YesodDsl.Generator.EntityFactories import YesodDsl.Generator.Classes import YesodDsl.Generator.Routes import YesodDsl.Generator.Validation import YesodDsl.Generator.Handlers import YesodDsl.Generator.EsqueletoInstances import YesodDsl.Generator.Cabal import YesodDsl.Generator.Fay import YesodDsl.SyncFile import Control.Monad.State import YesodDsl.Generator.Esqueleto import Data.Generics import Data.Generics.Uniplate.Data import qualified Data.Map as Map allImports :: Module -> String allImports m = concatMap fmtImport $ modImports m fmtImport :: Import -> String fmtImport i = T.unpack $(codegenFile "codegen/import.cg") writeRoute :: Module -> Route -> IO () writeRoute m r = do let (content, _) = runState (liftM concat $ mapM handler (routeHandlers r)) ((emptyContext m) { ctxRoute = Just r}) syncFile (joinPath ["Handler", moduleName m, routeModuleName r ++ ".hs"]) $ T.unpack $(codegenFile "codegen/route-header.cg") ++ content where imports = concatMap fmtImport $ filter ((`elem` modules) . importModule) $ modImports m modules = nub $ catMaybes $ [ Map.lookup fn importedFunctions | fn <- usedFunctions ] importedFunctions = Map.fromList [ (fn, importModule i) | i <- modImports m, fn <- importFunctions i ] usedFunctions = [ fn | Call fn _ <- universeBi r ] ++ [ fn | ExternExpr fn _ <- universeBi r ] ++ concat [ catMaybes [ mm | (_,_,mm) <- ifs ] | Update _ _ (Just ifs) <- universeBi r ] ++ concat [ catMaybes [ mm | (_,_,mm) <- ifs ] | Insert _ (Just (Just _, ifs)) _ <- universeBi r ] generate :: FilePath -> Module -> IO () generate path m = do syncCabal path m createDirectoryIfMissing True (joinPath ["Handler", moduleName m]) syncFile (joinPath ["Handler", moduleName m, "Enums.hs"]) $ T.unpack $(codegenFile "codegen/enums-header.cg") ++ (concatMap enum $ modEnums m) syncFile (joinPath ["Handler", moduleName m, "Esqueleto.hs"]) $ T.unpack $(codegenFile "codegen/esqueleto-header.cg") ++ (esqueletoInstances m) forM_ (modRoutes m) (writeRoute m) syncFile (joinPath ["Handler", moduleName m, "Internal.hs"]) $ T.unpack $(codegenFile "codegen/header.cg") ++ models m ++ entityFactories m ++ classes m ++ (T.unpack $(codegenFile "codegen/json-wrapper.cg")) syncFile (joinPath ["Handler", moduleName m, "Validation.hs"]) $ T.unpack $(codegenFile "codegen/validation-header.cg") ++ (concatMap validationEntity (modEntities m)) syncFile (joinPath ["Handler", moduleName m, "Routes.hs"]) $ routes m syncFile (joinPath ["Handler", moduleName m ++ ".hs"]) $ T.unpack $(codegenFile "codegen/dispatch.cg") syncFile (joinPath ["Handler", moduleName m, "PathPieces.hs"]) $ T.unpack $(codegenFile "codegen/path-pieces.cg") where routeImport r = T.unpack $(codegenFile "codegen/route-import.cg") genFay :: FilePath -> Module -> IO () genFay path m = do syncFile path $ fay m