yesod-default (empty) → 0.3.1
raw patch · 7 files changed
+347/−0 lines, 7 filesdep +basedep +bytestringdep +cmdargssetup-changed
Dependencies added: base, bytestring, cmdargs, directory, shakespeare-css, shakespeare-js, template-haskell, text, transformers, unix, wai, wai-extra, warp, yesod-core
Files
- LICENSE +25/−0
- Setup.lhs +7/−0
- Yesod/Default/Config.hs +75/−0
- Yesod/Default/Handlers.hs +14/−0
- Yesod/Default/Main.hs +101/−0
- Yesod/Default/Util.hs +79/−0
- yesod-default.cabal +46/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ Yesod/Default/Config.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Yesod.Default.Config+ ( DefaultEnv(..)+ , ArgConfig(..)+ , defaultArgConfig+ , fromArgs+ , fromArgsWith+ , loadDevelopmentConfig++ -- reexport+ , module Yesod.Config+ ) where++import Yesod.Config+import Data.Char (toUpper, toLower)+import System.Console.CmdArgs hiding (args)++-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and+-- Production environments+data DefaultEnv = Development+ | Testing+ | Staging+ | Production deriving (Read, Show, Enum, Bounded)++-- | Setup commandline arguments for environment and port+data ArgConfig = ArgConfig+ { environment :: String+ , port :: Int+ } deriving (Show, Data, Typeable)++-- | A default @'ArgConfig'@ if using the provided @'DefaultEnv'@ type.+defaultArgConfig :: ArgConfig+defaultArgConfig =+ ArgConfig+ { environment = "development"+ &= help ("application environment, one of: " ++ environments)+ &= typ "ENVIRONMENT"+ , port = def+ &= help "the port to listen on"+ &= typ "PORT"+ }++ where+ environments :: String+ environments = foldl1 (\a b -> a ++ ", " ++ b)+ . map ((map toLower) . show)+ $ ([minBound..maxBound] :: [DefaultEnv])++-- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from+-- commandline arguments.+fromArgs :: IO (AppConfig DefaultEnv)+fromArgs = fromArgsWith defaultArgConfig++fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)+fromArgsWith argConfig = do+ args <- cmdArgs argConfig++ env <-+ case reads $ capitalize $ environment args of+ (e, _):_ -> return e+ [] -> error $ "Invalid environment: " ++ environment args++ config <- loadConfig env++ return $ if port args /= 0+ then config { appPort = port args }+ else config++ where+ capitalize [] = []+ capitalize (x:xs) = toUpper x : map toLower xs++-- | Load your development config (when using @'DefaultEnv'@)+loadDevelopmentConfig :: IO (AppConfig DefaultEnv)+loadDevelopmentConfig = loadConfig Development
+ Yesod/Default/Handlers.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Yesod.Default.Handlers+ ( getFaviconR+ , getRobotsR+ ) where++import Yesod.Handler (GHandler, sendFile)+import Yesod.Content (RepPlain(..), ToContent(..))++getFaviconR :: GHandler s m ()+getFaviconR = sendFile "image/x-icon" "config/favicon.ico"++getRobotsR :: GHandler s m RepPlain+getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: String)
+ Yesod/Default/Main.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Yesod.Default.Main+ ( defaultMain+ , defaultRunner+ , defaultDevelApp+ , defaultDevelAppWith+ ) where++import Yesod.Core+import Yesod.Default.Config+import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)+import Network.Wai (Application)+import Network.Wai.Handler.Warp (run)+import Network.Wai.Middleware.Debug (debugHandle)++#ifndef WINDOWS+import qualified System.Posix.Signals as Signal+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+#endif++-- | Run your app, taking environment and port settings from the+-- commandline.+--+-- Use @'fromArgs'@ when using the provided @'DefaultEnv'@ type, or+-- @'fromArgsWith'@ when using a custom type+--+-- > main :: IO ()+-- > main = defaultMain fromArgs withMySite+--+-- or+--+-- > main :: IO ()+-- > main = defaultMain (fromArgsWith customArgConfig) withMySite+--+defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()+defaultMain load withSite = do+ config <- load+ logger <- makeLogger+ withSite config logger $ run (appPort config)++-- | Run your application continously, listening for SIGINT and exiting+-- when recieved+--+-- > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO ()+-- > withYourSite conf logger f = do+-- > Settings.withConnectionPool conf $ \p -> do+-- > runConnectionPool (runMigration yourMigration) p+-- > defaultRunner f $ YourSite conf logger p+--+-- TODO: ifdef WINDOWS+--+defaultRunner :: (YesodDispatch y y, Yesod y)+ => (Application -> IO a)+ -> y -- ^ your foundation type+ -> IO ()+defaultRunner f h =+#ifdef WINDOWS+ toWaiApp h >>= f >> return ()+#else+ do+ tid <- forkIO $ toWaiApp h >>= f >> return ()+ flag <- newEmptyMVar+ _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do+ putStrLn "Caught an interrupt"+ killThread tid+ putMVar flag ()) Nothing+ takeMVar flag+#endif++-- | Run your development app using the provided @'DefaultEnv'@ type+--+-- > withDevelAppPort :: Dynamic+-- > withDevelAppPort = toDyn $ defaultDevelApp withMySite+--+defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ())+ -> ((Int, Application) -> IO ())+ -> IO ()+defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig++-- | Run your development app using a custom environment type and loader+-- function+--+-- > withDevelAppPort :: Dynamic+-- > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite+--+defaultDevelAppWith :: (Show e, Read e)+ => IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@+ -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function+ -> ((Int, Application) -> IO ()) -> IO ()+defaultDevelAppWith load withSite f = do+ conf <- load+ logger <- makeLogger+ let p = appPort conf+ logString logger $ "Devel application launched, listening on port " ++ show p+ withSite conf logger $ \app -> f (p, debugHandle (logHandle logger) app)+ flushLogger logger++ where+ logHandle logger msg = logLazyText logger msg >> flushLogger logger
+ Yesod/Default/Util.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+-- | Various utilities used in the scaffolded site.+module Yesod.Default.Util+ ( addStaticContentExternal+ , globFile+ , widgetFileProduction+ , widgetFileDebug+ ) where++import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Lazy as L+import Data.Text (Text, pack, unpack)+import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent+import Control.Monad (unless)+import System.Directory (doesFileExist, createDirectoryIfMissing)+import Language.Haskell.TH.Syntax+import Text.Lucius (luciusFile, luciusFileDebug)+import Text.Julius (juliusFile, juliusFileDebug)+import Text.Cassius (cassiusFile, cassiusFileDebug)+import Data.Monoid (mempty)++-- | An implementation of 'addStaticContent' which stores the contents in an+-- external file. Files are created in the given static folder with names based+-- on a hash of their content. This allows expiration dates to be set far in+-- the future without worry of users receiving stale content.+addStaticContentExternal+ :: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier+ -> (L.ByteString -> String) -- ^ hash function to determine file name+ -> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder+ -> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces+ -> Text -- ^ filename extension+ -> Text -- ^ mime type+ -> L.ByteString -- ^ file contents+ -> GHandler sub master (Maybe (Either Text (Route master, [(Text, Text)])))+addStaticContentExternal minify hash staticDir toRoute ext' _ content = do+ liftIO $ createDirectoryIfMissing True statictmp+ exists <- liftIO $ doesFileExist fn'+ unless exists $ liftIO $ L.writeFile fn' content'+ return $ Just $ Right (toRoute ["tmp", pack fn], [])+ where+ fn, statictmp, fn' :: FilePath+ -- by basing the hash off of the un-minified content, we avoid a costly+ -- minification if the file already exists+ fn = hash content ++ '.' : unpack ext'+ statictmp = staticDir ++ "/tmp/"+ fn' = statictmp ++ fn++ content' :: L.ByteString+ content'+ | ext' == "js" = either (const content) id $ minify content+ | otherwise = content++-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/+globFile :: String -> String -> FilePath+globFile kind x = kind ++ "/" ++ x ++ "." ++ kind++widgetFileProduction :: FilePath -> Q Exp+widgetFileProduction x = do+ let h = whenExists x "hamlet" whamletFile+ let c = whenExists x "cassius" cassiusFile+ let j = whenExists x "julius" juliusFile+ let l = whenExists x "lucius" luciusFile+ [|$h >> addCassius $c >> addJulius $j >> addLucius $l|]++widgetFileDebug :: FilePath -> Q Exp+widgetFileDebug x = do+ let h = whenExists x "hamlet" whamletFile+ let c = whenExists x "cassius" cassiusFileDebug+ let j = whenExists x "julius" juliusFileDebug+ let l = whenExists x "lucius" luciusFileDebug+ [|$h >> addCassius $c >> addJulius $j >> addLucius $l|]++whenExists :: String -> String -> (FilePath -> Q Exp) -> Q Exp+whenExists x glob f = do+ let fn = globFile glob x+ e <- qRunIO $ doesFileExist fn+ if e then f fn else [|mempty|]
+ yesod-default.cabal view
@@ -0,0 +1,46 @@+name: yesod-default+version: 0.3.1+license: BSD3+license-file: LICENSE+author: Patrick Brisbin+maintainer: Patrick Brisbin <pbrisbin@gmail.com>+synopsis: Default config and main functions for your yesod application+category: Web, Yesod+stability: Stable+cabal-version: >= 1.6+build-type: Simple+homepage: http://www.yesodweb.com/+description: Convenient wrappers for your the configuration and+ execution of your yesod application++library+ if os(windows)+ cpp-options: -DWINDOWS++ build-depends: base >= 4 && < 5+ , yesod-core >= 0.9 && < 0.10+ , cmdargs >= 0.8 && < 0.9+ , warp >= 0.4 && < 0.5+ , wai >= 0.4 && < 0.5+ , wai-extra >= 0.4 && < 0.5+ , bytestring >= 0.9 && < 0.10+ , transformers >= 0.2 && < 0.3+ , text >= 0.9 && < 1.0+ , directory >= 1.0 && < 1.2+ , shakespeare-css >= 0.10 && < 0.11+ , shakespeare-js >= 0.10 && < 0.11+ , template-haskell++ if !os(windows)+ build-depends: unix++ exposed-modules: Yesod.Default.Config+ , Yesod.Default.Main+ , Yesod.Default.Util+ , Yesod.Default.Handlers++ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/yesodweb/yesod.git