yesod-dsl-0.1.1.23: YesodDsl/Generator.hs

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