add shakespeare-text

This commit is contained in:
Greg Weber 2011-08-12 19:31:26 -07:00
parent 606a0b070b
commit d36502dd0e
7 changed files with 48 additions and 33 deletions

View File

@ -92,13 +92,19 @@ scaffold = do
puts $(codegenDir "input" "database") puts $(codegenDir "input" "database")
backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends
let (backend, importGenericDB, dbMonad, importDB, mkPersistSettings) = let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) =
case backendC of case backendC of
"s" -> (Sqlite, "GenericSql", "SqlPersist", "import Database.Persist.Sqlite\n", "sqlSettings") "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite\n", "sqlSettings")
"p" -> (Postgresql, "GenericSql", "SqlPersist", "import Database.Persist.Postgresql\n", "sqlSettings") "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql\n", "sqlSettings")
"m" -> (MongoDB, "MongoDB", "Action", "import Database.Persist.MongoDB\nimport Control.Applicative (Applicative)\n", "MkPersistSettings { mpsBackend = ConT ''Action }") "m" -> (MongoDB, "MongoDB", "Action", "MongoDB\nimport Control.Applicative (Applicative)\n", "MkPersistSettings { mpsBackend = ConT ''Action }")
"t" -> (Tiny, "","","","") "t" -> (Tiny, "","","",undefined)
_ -> error $ "Invalid backend: " ++ backendC _ -> error $ "Invalid backend: " ++ backendC
(modelImports) = case backend of
MongoDB -> "import Database.Persist." ++ importGenericDB ++ "\nimport Language.Haskell.TH.Syntax"
Sqlite -> ""
Postgresql -> ""
Tiny -> undefined
uncapitalize s = toLower (head s) : tail s uncapitalize s = toLower (head s) : tail s
backendLower = uncapitalize $ show backend backendLower = uncapitalize $ show backend
upper = show backend upper = show backend
@ -111,9 +117,9 @@ scaffold = do
MongoDB -> $(codegen $ "mongoDBConnPool") MongoDB -> $(codegen $ "mongoDBConnPool")
Tiny -> "" Tiny -> ""
textImport = case backend of settingsTextImport = case backend of
Postgresql -> ", concat, append, snoc, pack" Postgresql -> "import Text.Shakespeare.Text (st)\nimport Data.Text (Text, concat)"
_ -> "" _ -> "import Data.Text"
packages = if backend == MongoDB then ", mongoDB\n , bson\n" else "" packages = if backend == MongoDB then ", mongoDB\n , bson\n" else ""

View File

@ -3,8 +3,7 @@ module Model where
import Yesod import Yesod
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.~importGenericDB~ ~modelImports~
import Language.Haskell.TH.Syntax
-- You can define all of your database entities in the entities file. -- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities -- You can find more information on persistent and how to declare entities

View File

@ -1,5 +1,5 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc. -- includes database connection settings, static file locations, etc.
@ -11,6 +11,7 @@ module Settings
, cassiusFile , cassiusFile
, juliusFile , juliusFile
, luciusFile , luciusFile
, textFile
, widgetFile , widgetFile
, ConnectionPool , ConnectionPool
, withConnectionPool , withConnectionPool
@ -22,17 +23,19 @@ module Settings
, AppConfig(..) , AppConfig(..)
) where ) where
import qualified Text.Hamlet as H import qualified Text.Hamlet as S
import qualified Text.Cassius as H import qualified Text.Cassius as S
import qualified Text.Julius as H import qualified Text.Julius as S
import qualified Text.Lucius as H import qualified Text.Lucius as S
import qualified Text.Shakespeare.Text as S
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
~importDB~ import Database.Persist.~importPersist~
import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius, whamletFile) import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius, whamletFile)
import Data.Monoid (mempty, mappend) import Data.Monoid (mempty)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Prelude hiding (concat) import Prelude hiding (concat)
import Data.Text (Text~textImport~) ~settingsTextImport~
import Data.Object import Data.Object
import qualified Data.Object.Yaml as YAML import qualified Data.Object.Yaml as YAML
import Control.Monad (join) import Control.Monad (join)
@ -114,7 +117,7 @@ staticDir = "static"
-- --
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs -- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticRoot :: AppConfig -> Text staticRoot :: AppConfig -> Text
staticRoot conf = (appRoot conf) `mappend` "/static" staticRoot conf = [st|#{appRoot conf}/static|]
-- The rest of this file contains settings which rarely need changing by a -- The rest of this file contains settings which rarely need changing by a
@ -144,30 +147,38 @@ globFile :: String -> String -> FilePath
globFile kind x = kind ++ "/" ++ x ++ "." ++ kind globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
hamletFile :: FilePath -> Q Exp hamletFile :: FilePath -> Q Exp
hamletFile = H.hamletFile . globFile "hamlet" hamletFile = S.hamletFile . globFile "hamlet"
cassiusFile :: FilePath -> Q Exp cassiusFile :: FilePath -> Q Exp
cassiusFile = cassiusFile =
#ifdef PRODUCTION #ifdef PRODUCTION
H.cassiusFile . globFile "cassius" S.cassiusFile . globFile "cassius"
#else #else
H.cassiusFileDebug . globFile "cassius" S.cassiusFileDebug . globFile "cassius"
#endif #endif
luciusFile :: FilePath -> Q Exp luciusFile :: FilePath -> Q Exp
luciusFile = luciusFile =
#ifdef PRODUCTION #ifdef PRODUCTION
H.luciusFile . globFile "lucius" S.luciusFile . globFile "lucius"
#else #else
H.luciusFileDebug . globFile "lucius" S.luciusFileDebug . globFile "lucius"
#endif #endif
juliusFile :: FilePath -> Q Exp juliusFile :: FilePath -> Q Exp
juliusFile = juliusFile =
#ifdef PRODUCTION #ifdef PRODUCTION
H.juliusFile . globFile "julius" S.juliusFile . globFile "julius"
#else #else
H.juliusFileDebug . globFile "julius" S.juliusFileDebug . globFile "julius"
#endif
textFile :: FilePath -> Q Exp
textFile =
#ifdef PRODUCTION
S.textFile . globFile "text"
#else
S.textFileDebug . globFile "text"
#endif #endif
widgetFile :: FilePath -> Q Exp widgetFile :: FilePath -> Q Exp

View File

@ -1,5 +1,5 @@
Default: &defaults Default: &defaults
appRoot: http://localhost appRoot: "http://localhost"
appPort: 3000 appPort: 3000
connectionPoolSize: 10 connectionPoolSize: 10

View File

@ -12,12 +12,12 @@ withConnectionPool conf f = do
loadConnStr env = do loadConnStr env = do
allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings settings <- lookupMapping (show env) allSettings
database <- lookupScalar "database" settings database <- lookupScalar "database" settings :: IO Text
connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do
value <- lookupScalar key settings value <- lookupScalar key settings
return $ append (snoc (pack key) '=') (snoc value ' ') return $ [st| #{key}=#{value} |]
return $ append connPart (append " dbname= " database) return $ [st|#{connPart} dbname=#{database}|]
-- Example of making a dynamic configuration static -- Example of making a dynamic configuration static
-- use /return $(mkConnStr Production)/ instead of loadConnStr -- use /return $(mkConnStr Production)/ instead of loadConnStr

View File

@ -70,6 +70,7 @@ executable ~project~
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11 , shakespeare-js >= 0.10 && < 0.11
, shakespeare-text >= 0.10 && < 0.11
, hjsmin , hjsmin
, transformers , transformers
, data-object , data-object

View File

@ -12,9 +12,7 @@ withConnectionPool conf f = do
loadConnStr env = do loadConnStr env = do
allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings settings <- lookupMapping (show env) allSettings
database <- lookupScalar "database" settings lookupScalar "database" settings
return database
-- Example of making a dynamic configuration static -- Example of making a dynamic configuration static
-- use /return $(mkConnStr Production)/ instead of loadConnStr -- use /return $(mkConnStr Production)/ instead of loadConnStr