haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

data-object-yaml to yaml 0.5

Browse Source
This commit is contained in:
Michael Snoyman 2011-12-28 17:07:53 +02:00
parent 50ce1da37e
commit c90cf34ef5
17 changed files with 114 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
yesod-core/yesod-core.cabal
View File

@ -73,8 +73,6 @@ library
, case-insensitive >= 0.2
, parsec >= 2 && < 3.2
, directory >= 1 && < 1.2
, data-object >= 0.3 && < 0.4
, data-object-yaml >= 0.3 && < 0.4
, vector >= 0.9 && < 0.10
, aeson >= 0.5
, fast-logger >= 0.0.1

49
yesod-default/Yesod/Default/Config.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Yesod.Default.Config
( DefaultEnv (..)
, fromArgs
@ -18,10 +19,9 @@ import Data.Char (toUpper, toLower)
import System.Console.CmdArgs hiding (args)
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (join)
import Data.Object
import Data.Object.Yaml
import Data.Yaml
import Data.Maybe (fromMaybe)
import qualified Data.HashMap.Strict as M
-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
-- Production environments
@ -55,13 +55,13 @@ fromArgs = fromArgsExtra (const $ const $ return ())
-- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra'
-- record.
fromArgsExtra :: (DefaultEnv -> TextObject -> IO extra)
fromArgsExtra :: (DefaultEnv -> Value -> IO extra)
-> IO (AppConfig DefaultEnv extra)
fromArgsExtra = fromArgsWith defaultArgConfig
fromArgsWith :: (Read env, Show env)
=> ArgConfig
-> (env -> TextObject -> IO extra)
-> (env -> Value -> IO extra)
-> IO (AppConfig env extra)
fromArgsWith argConfig getExtra = do
args <- cmdArgs argConfig
@ -103,12 +103,12 @@ data ConfigSettings environment extra = ConfigSettings
-- environment. Usually, you will use 'DefaultEnv' for this type.
csEnv :: environment
-- | Load any extra data, to be used by the application.
, csLoadExtra :: environment -> TextObject -> IO extra
, csLoadExtra :: environment -> Value -> IO extra
-- | Return the path to the YAML config file.
, csFile :: environment -> IO FilePath
-- | Get the sub-object (if relevant) from the given YAML source which
-- contains the specific settings for the current environment.
, csGetObject :: environment -> TextObject -> IO TextObject
, csGetObject :: environment -> Value -> IO Value
}
-- | Default config settings.
@ -117,14 +117,17 @@ configSettings env0 = ConfigSettings
{ csEnv = env0
, csLoadExtra = \_ _ -> return ()
, csFile = \_ -> return "config/settings.yml"
, csGetObject = \env obj -> do
envs <- fromMapping obj
, csGetObject = \env v -> do
envs <-
case v of
Object obj -> return obj
_ -> fail "Expected Object"
let senv = show env
tenv = T.pack senv
maybe
(error $ "Could not find environment: " ++ senv)
return
(lookup tenv envs)
(M.lookup tenv envs)
}
-- | Load an @'AppConfig'@.
@ -160,10 +163,14 @@ loadConfig :: ConfigSettings environment extra
-> IO (AppConfig environment extra)
loadConfig (ConfigSettings env loadExtra getFile getObject) = do
fp <- getFile env
topObj <- join $ decodeFile fp
mtopObj <- decodeFile fp
topObj <- maybe (fail "Invalid YAML file") return mtopObj
obj <- getObject env topObj
m <-
case obj of
Object m -> return m
_ -> fail "Expected map"
m <- maybe (fail "Expected map") return $ fromMapping obj
let mssl = lookupScalar "ssl" m
let mhost = lookupScalar "host" m
let mport = lookupScalar "port" m
@ -192,6 +199,11 @@ loadConfig (ConfigSettings env loadExtra getFile getObject) = do
}
where
lookupScalar k m =
case M.lookup k m of
Just (String t) -> return t
Just _ -> fail $ "Invalid value for: " ++ show k
Nothing -> fail $ "Not found: " ++ show k
toBool :: Text -> Bool
toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"])
@ -216,11 +228,12 @@ safeRead name' t = case reads s of
withYamlEnvironment :: Show e
=> FilePath -- ^ the yaml file
-> e -- ^ the environment you want to load
-> (TextObject -> IO a) -- ^ what to do with the mapping
-> (Value -> IO a) -- ^ what to do with the mapping
-> IO a
withYamlEnvironment fp env f = do
obj <- join $ decodeFile fp
envs <- fromMapping obj
conf <- maybe (fail $ "Could not find environment: " ++ show env) return
$ lookup (T.pack $ show env) envs
f conf
mval <- decodeFile fp
case mval of
Nothing -> fail $ "Invalid YAML file: " ++ show fp
Just (Object obj)
| Just v <- M.lookup (T.pack $ show env) obj -> f v
_ -> fail $ "Could not find environment: " ++ show env

4
yesod-default/yesod-default.cabal
View File

@ -30,8 +30,8 @@ library
, shakespeare-css >= 0.10.5 && < 0.11
, shakespeare-js >= 0.10.4 && < 0.11
, template-haskell
, data-object >= 0.3 && < 0.4
, data-object-yaml >= 0.3 && < 0.4
, yaml >= 0.5 && < 0.6
, unordered-containers
if !os(windows)
build-depends: unix

3
yesod-form/Yesod/Form/Types.hs
View File

@ -10,7 +10,6 @@ module Yesod.Form.Types
, FileEnv
, Ints (..)
-- * Form
, Form
, MForm
, AForm (..)
-- * Build forms
@ -75,8 +74,6 @@ type Env = Map.Map Text [Text]
type FileEnv = Map.Map Text FileInfo
type Lang = Text
type Form sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandlerT sub master IO) a
{-# DEPRECATED Form "Use MForm instead" #-}
type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandlerT sub master IO) a
newtype AForm sub master a = AForm

13
yesod-json/Yesod/Json.hs
View File

@ -9,8 +9,8 @@ module Yesod.Json
, parseJsonBody
-- * Produce JSON values
, J.Value (..)
, toObject
, toArray
, object
, array
) where
import Yesod.Handler (GHandler, waiRequest)
@ -26,7 +26,6 @@ import Data.Aeson.Encode (fromValue)
import Data.Conduit.Attoparsec (sinkParser)
import Data.Text (Text)
import Control.Monad.Trans.Class (lift)
import Data.HashMap.Strict (fromList)
import qualified Data.Vector as V
import Text.Julius (ToJavascript (..))
import Data.Text.Lazy.Builder (fromLazyText)
@ -68,9 +67,9 @@ instance ToJavascript J.Value where
toJavascript = fromLazyText . decodeUtf8 . JE.encode
-- | Convert a list of pairs to an 'J.Object'.
toObject :: [(Text, J.Value)] -> J.Value
toObject = J.Object . fromList
object :: [(Text, J.Value)] -> J.Value
object = J.object
-- | Convert a list of values to an 'J.Array'.
toArray :: [J.Value] -> J.Value
toArray = J.Array . V.fromList
array :: [J.Value] -> J.Value
array = J.Array . V.fromList

1
yesod-json/yesod-json.cabal
View File

@ -20,7 +20,6 @@ library
, shakespeare-js >= 0.10 && < 0.11
, vector >= 0.9
, containers >= 0.2
, unordered-containers
, blaze-builder
, attoparsec-conduit >= 0.0 && < 0.1
, conduit >= 0.0 && < 0.1

4
yesod/Scaffolding/Scaffolder.hs
View File

@ -66,8 +66,8 @@ scaffold = do
backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends
let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) =
case backendC of
"s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlSettings")
"p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlSettings")
"s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlMkSettings")
"p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlMkSettings")
"m" -> (MongoDB, "MongoDB", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }")
"t" -> (Tiny, "","","",undefined)
_ -> error $ "Invalid backend: " ++ backendC

16
yesod/scaffold/Application.hs.cg
View File

@ -19,7 +19,7 @@ import Network.Wai.Middleware.RequestLogger (logHandleDev)
import Yesod.Logger (Logger)
import Network.Wai.Middleware.RequestLogger (logStdout)
#endif
import qualified Database.Persist.Base~importMigration~
import qualified Database.Persist.Store~importMigration~
-- Import all relevant handler modules here.
import Handler.Root
@ -33,12 +33,12 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ :: AppConfig DefaultEnv Extra -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ conf logger f = do
s <- staticSite
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
$ either error return . Database.Persist.Base.loadConfig
Database.Persist.Base.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~
$ either error return . Database.Persist.Store.loadConfig
Database.Persist.Store.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~
let h = ~sitearg~ conf logger s p
defaultRunner (f . logWare) h
where
@ -50,4 +50,10 @@ with~sitearg~ conf logger f = do
-- for yesod devel
withDevelAppPort :: Dynamic
withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~
withDevelAppPort =
toDyn $ defaultDevelAppWith loader with~sitearg~
where
loader = loadConfig (configSettings Development)
{ csLoadExtra = loadExtra
}

13
yesod/scaffold/Foundation.hs.cg
View File

@ -16,7 +16,7 @@ module Foundation
) where
import Prelude
import Yesod hiding (Form, AppConfig (..), withYamlEnvironment)
import Yesod
import Yesod.Static (Static, base64md5, StaticRoute(..))
import Settings.StaticFiles
import Yesod.Auth
@ -29,9 +29,9 @@ import Yesod.Logger (logLazyText)
#endif
import qualified Settings
import qualified Data.ByteString.Lazy as L
import qualified Database.Persist.Base
import qualified Database.Persist.Store
import Database.Persist.~importGenericDB~
import Settings (widgetFile)
import Settings (widgetFile, Extra)
import Model
import Text.Jasmine (minifym)
import Web.ClientSession (getKey)
@ -47,10 +47,10 @@ import Network.Mail.Mime (sendmail)
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv ()
{ settings :: AppConfig DefaultEnv Extra
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Database.Persist.Base.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
}
-- Set up i18n messages. See the message folder.
@ -125,8 +125,7 @@ instance Yesod ~sitearg~ where
-- How to run database actions.
instance YesodPersist ~sitearg~ where
type YesodPersistBackend ~sitearg~ = ~dbMonad~
runDB f = liftIOHandler
$ fmap connPool getYesod >>= Database.Persist.Base.runPool (undefined :: Settings.PersistConfig) f
runDB f = fmap connPool getYesod >>= Database.Persist.Store.runPool (undefined :: Settings.PersistConfig) f
instance YesodAuth ~sitearg~ where
type AuthId ~sitearg~ = UserId

4
yesod/scaffold/Model.hs.cg
View File

@ -3,11 +3,13 @@ module Model where
import Prelude
import Yesod
import Data.Text (Text)
import Database.Persist.Quasi
~modelImports~
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"] $(persistFile "config/models")
share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"]
$(persistFile upperCaseSettings "config/models")

11
yesod/scaffold/Settings.hs.cg
View File

@ -8,15 +8,18 @@ module Settings
, PersistConfig
, staticRoot
, staticDir
, Extra (..)
, loadExtra
) where
import Prelude (FilePath, String)
import Prelude
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Database.Persist.~importPersist~ (~configPersist~)
import Yesod.Default.Config
import qualified Yesod.Default.Util
import Data.Text (Text)
import Data.Yaml
-- | Which Persistent backend this site is using.
type PersistConfig = ~configPersist~
@ -54,3 +57,9 @@ widgetFile = Yesod.Default.Util.widgetFileReload
#else
widgetFile = Yesod.Default.Util.widgetFileNoReload
#endif
data Extra = Extra
loadExtra :: DefaultEnv -> Value -> IO Extra
loadExtra _ _ = return Extra

9
yesod/scaffold/main.hs.cg
View File

@ -1,7 +1,8 @@
import Yesod.Default.Config (fromArgs)
import Yesod.Default.Main (defaultMain)
import Application (with~sitearg~)
import Prelude (IO)
import Yesod.Default.Config (fromArgsExtra)
import Yesod.Default.Main (defaultMain)
import Settings (loadExtra)
import Application (with~sitearg~)
main :: IO ()
main = defaultMain fromArgs with~sitearg~
main = defaultMain (fromArgsExtra loadExtra) with~sitearg~

21
yesod/scaffold/project.cabal.cg
View File

@ -74,24 +74,25 @@ executable ~project~
FlexibleContexts
build-depends: base >= 4 && < 5
, yesod >= 0.9.3.4 && < 0.10
, yesod-core >= 0.9.3 && < 0.10
, yesod-auth >= 0.7.3 && < 0.8
, yesod-static >= 0.3.1 && < 0.4
, yesod-default >= 0.5 && < 0.6
, yesod-form >= 0.3.4 && < 0.4
, yesod >= 0.10 && < 0.11
, yesod-core >= 0.10 && < 0.11
, yesod-auth >= 0.8 && < 0.9
, yesod-static >= 0.10 && < 0.11
, yesod-default >= 0.6 && < 0.7
, yesod-form >= 0.4 && < 0.5
, mime-mail >= 0.3.0.3 && < 0.5
, clientsession >= 0.7.3 && < 0.8
, bytestring >= 0.9 && < 0.10
, text >= 0.11 && < 0.12
, persistent >= 0.6.2 && < 0.7
, persistent-~backendLower~ >= 0.6 && < 0.7
, persistent >= 0.7 && < 0.8
, persistent-~backendLower~ >= 0.7 && < 0.8
, template-haskell
, hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, shakespeare-text >= 0.10 && < 0.11
, hjsmin >= 0.0.14 && < 0.1
, monad-control ~monadControlVersion~
, wai-extra >= 0.4.6 && < 0.5
, monad-control >= 0.3 && < 0.4
, wai-extra >= 1.0 && < 1.1
, yaml >= 0.5 && < 0.6

13
yesod/scaffold/tiny/Application.hs.cg
View File

@ -5,9 +5,10 @@ module Application
) where
import Import
import Settings (loadExtra)
import Settings.StaticFiles (staticSite)
import Yesod.Default.Config
import Yesod.Default.Main (defaultDevelApp, defaultRunner)
import Yesod.Default.Main (defaultDevelAppWith, defaultRunner)
import Yesod.Default.Handlers (getFaviconR, getRobotsR)
import Yesod.Logger (Logger)
import Network.Wai (Application)
@ -25,7 +26,7 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ :: AppConfig DefaultEnv Extra -> Logger -> (Application -> IO ()) -> IO ()
with~sitearg~ conf logger f = do
s <- staticSite
let h = ~sitearg~ conf logger s
@ -33,4 +34,10 @@ with~sitearg~ conf logger f = do
-- for yesod devel
withDevelAppPort :: Dynamic
withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~
withDevelAppPort =
toDyn $ defaultDevelAppWith loader withFoobar
where
loader = loadConfig (configSettings Development)
{ csLoadExtra = loadExtra
}

6
yesod/scaffold/tiny/Foundation.hs.cg
View File

@ -13,14 +13,14 @@ module Foundation
) where
import Prelude
import Yesod.Core hiding (AppConfig (..))
import Yesod.Core
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Static (Static, base64md5, StaticRoute(..))
import Settings.StaticFiles
import Yesod.Logger (Logger, logMsg, formatLogText)
import qualified Settings
import Settings (widgetFile)
import Settings (Extra, widgetFile)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import Web.ClientSession (getKey)
@ -31,7 +31,7 @@ import Text.Hamlet (hamletFile)
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv ()
{ settings :: AppConfig DefaultEnv Extra
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
}

10
yesod/scaffold/tiny/Settings.hs.cg
View File

@ -7,14 +7,17 @@ module Settings
( widgetFile
, staticRoot
, staticDir
, Extra (..)
, loadExtra
) where
import Prelude (FilePath, String)
import Prelude
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Yesod.Default.Config
import qualified Yesod.Default.Util
import Data.Text (Text)
import Data.Yaml
-- | The location of static files on your system. This is a file system
-- path. The default value works properly with your scaffolded site.
@ -43,3 +46,8 @@ widgetFile = Yesod.Default.Util.widgetFileReload
#else
widgetFile = Yesod.Default.Util.widgetFileNoReload
#endif
data Extra = Extra
loadExtra :: DefaultEnv -> Value -> IO Extra
loadExtra _ _ = return Extra

9
yesod/scaffold/tiny/project.cabal.cg
View File

@ -66,16 +66,17 @@ executable ~project~
TypeFamilies
build-depends: base >= 4 && < 5
, yesod-core >= 0.9.3 && < 0.10
, yesod-static >= 0.3.1 && < 0.4
, yesod-default >= 0.5 && < 0.6
, yesod-core >= 0.10 && < 0.11
, yesod-static >= 0.10 && < 0.11
, yesod-default >= 0.6 && < 0.7
, clientsession >= 0.7.3 && < 0.8
, bytestring >= 0.9 && < 0.10
, text >= 0.11 && < 0.12
, template-haskell
, hamlet >= 0.10 && < 0.11
, shakespeare-text >= 0.10 && < 0.11
, wai >= 0.4.2 && < 0.5
, wai >= 1.0 && < 1.1
, transformers >= 0.2 && < 0.3
, monad-control >= 0.3 && < 0.4
, yaml >= 0.5 && < 0.6