yesod-1.2.4/0000755000000000000000000000000012247534155011037 5ustar0000000000000000yesod-1.2.4/LICENSE0000644000000000000000000000207512247534155012050 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. yesod-1.2.4/yesod.cabal0000644000000000000000000000515112247534155013150 0ustar0000000000000000name: yesod version: 1.2.4 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Creation of type-safe, RESTful web applications. description: A RESTful web framework with strong compile-time guarantees of correctness. It also affords space efficient code, highly concurrent loads, and portability to many deployment backends (via the wai package), from CGI to stand-alone serving. . Yesod also focuses on developer productivity. Yesod integrates well with tools for all your basic web development (wai, persistent, and shakespeare/hamlet) . The Yesod documentation site has much more information, including on the supporting packages mentioned above. category: Web, Yesod stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://www.yesodweb.com/ library if os(windows) cpp-options: -DWINDOWS build-depends: base >= 4.3 && < 5 , yesod-core >= 1.2.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-persistent >= 1.2 && < 1.3 , yesod-form >= 1.3 && < 1.4 , monad-control >= 0.3 && < 0.4 , transformers >= 0.2.2 && < 0.4 , wai >= 1.3 , wai-extra >= 1.3 , hamlet >= 1.1 && < 1.2 , shakespeare-js >= 1.0.2 && < 1.3 , shakespeare-css >= 1.0 && < 1.1 , warp >= 1.3 , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , aeson , safe , data-default , network-conduit , unordered-containers , yaml , text , directory , template-haskell , bytestring exposed-modules: Yesod , Yesod.Default.Config , Yesod.Default.Main , Yesod.Default.Util , Yesod.Default.Handlers ghc-options: -Wall if !os(windows) build-depends: unix source-repository head type: git location: https://github.com/yesodweb/yesod yesod-1.2.4/Yesod.hs0000644000000000000000000000051012247534155012452 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | This module simply re-exports from other modules for your convenience. module Yesod ( -- * Re-exports from yesod-core module Yesod.Core , module Yesod.Form , module Yesod.Persist ) where import Yesod.Core import Yesod.Form import Yesod.Persist yesod-1.2.4/Setup.lhs0000644000000000000000000000016212247534155012646 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain yesod-1.2.4/Yesod/0000755000000000000000000000000012247534155012122 5ustar0000000000000000yesod-1.2.4/Yesod/Default/0000755000000000000000000000000012247534155013506 5ustar0000000000000000yesod-1.2.4/Yesod/Default/Handlers.hs0000644000000000000000000000050212247534155015577 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yesod.Default.Handlers ( getFaviconR , getRobotsR ) where import Yesod.Core getFaviconR :: MonadHandler m => m () getFaviconR = sendFile "image/x-icon" "config/favicon.ico" getRobotsR :: MonadHandler m => m () getRobotsR = sendFile "text/plain" "config/robots.txt" yesod-1.2.4/Yesod/Default/Util.hs0000644000000000000000000001223512247534155014762 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} -- | Various utilities used in the scaffolded site. module Yesod.Default.Util ( addStaticContentExternal , globFile , widgetFileNoReload , widgetFileReload , TemplateLanguage (..) , defaultTemplateLanguages , WidgetFileSettings , wfsLanguages , wfsHamletSettings ) where 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 (when, unless) import System.Directory (doesFileExist, createDirectoryIfMissing) import Language.Haskell.TH.Syntax import Text.Lucius (luciusFile, luciusFileReload) import Text.Julius (juliusFile, juliusFileReload) import Text.Cassius (cassiusFile, cassiusFileReload) import Text.Hamlet (HamletSettings, defaultHamletSettings) import Data.Maybe (catMaybes) import Data.Default (Default (def)) -- | 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 -> HandlerT master IO (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 file extension for each type, e.g: hamlet lucius julius globFile :: String -> String -> FilePath globFile kind x = "templates/" ++ x ++ "." ++ kind data TemplateLanguage = TemplateLanguage { tlRequiresToWidget :: Bool , tlExtension :: String , tlNoReload :: FilePath -> Q Exp , tlReload :: FilePath -> Q Exp } defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage] defaultTemplateLanguages hset = [ TemplateLanguage False "hamlet" whamletFile' whamletFile' , TemplateLanguage True "cassius" cassiusFile cassiusFileReload , TemplateLanguage True "julius" juliusFile juliusFileReload , TemplateLanguage True "lucius" luciusFile luciusFileReload ] where whamletFile' = whamletFileWithSettings hset data WidgetFileSettings = WidgetFileSettings { wfsLanguages :: HamletSettings -> [TemplateLanguage] , wfsHamletSettings :: HamletSettings } instance Default WidgetFileSettings where def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp combine func file isReload tls = do mexps <- qmexps case catMaybes mexps of [] -> error $ concat [ "Called " , func , " on " , show file , ", but no template were found." ] exps -> return $ DoE $ map NoBindS exps where qmexps :: Q [Maybe Exp] qmexps = mapM go tls go :: TemplateLanguage -> Q (Maybe Exp) go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl) whenExists :: String -> Bool -- ^ requires toWidget wrap -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) whenExists = warnUnlessExists False warnUnlessExists :: Bool -> String -> Bool -- ^ requires toWidget wrap -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp) warnUnlessExists shouldWarn x wrap glob f = do let fn = globFile glob x e <- qRunIO $ doesFileExist fn when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn if e then do ex <- f fn if wrap then do tw <- [|toWidget|] return $ Just $ tw `AppE` ex else return $ Just ex else return Nothing yesod-1.2.4/Yesod/Default/Main.hs0000644000000000000000000000624512247534155014735 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Yesod.Default.Main ( defaultMain , defaultRunner , defaultDevelApp ) where import Yesod.Default.Config import Network.Wai (Application) import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort, settingsHost) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def) import Network.Wai.Middleware.Autohead (autohead) import Network.Wai.Middleware.Jsonp (jsonp) import Control.Monad (when) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) import Safe (readMay) #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. -- -- @'fromArgs'@ helps parse a custom configuration -- -- > main :: IO () -- > main = defaultMain (fromArgs parseExtra) makeApplication -- defaultMain :: (Show env, Read env) => IO (AppConfig env extra) -> (AppConfig env extra -> IO Application) -> IO () defaultMain load getApp = do config <- load app <- getApp config runSettings defaultSettings { settingsPort = appPort config , settingsHost = appHost config } app -- | Run your application continously, listening for SIGINT and exiting -- when received -- -- > 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 defaultRunner :: (Application -> IO ()) -> Application -> IO () defaultRunner f app = do -- clear the .static-cache so we don't have stale content exists <- doesDirectoryExist staticCache when exists $ removeDirectoryRecursive staticCache #ifdef WINDOWS f (middlewares app) #else tid <- forkIO $ f (middlewares app) >> return () flag <- newEmptyMVar _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do putStrLn "Caught an interrupt" killThread tid putMVar flag ()) Nothing takeMVar flag #endif where middlewares = gzip gset . jsonp . autohead gset = def { gzipFiles = GzipCacheFolder staticCache } staticCache = ".static-cache" -- | Run your development app using a custom environment type and loader -- function defaultDevelApp :: (Show env, Read env) => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@ -> IO (Int, Application) defaultDevelApp load getApp = do conf <- load env <- getEnvironment let p = fromMaybe (appPort conf) $ lookup "PORT" env >>= readMay pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMay putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay app <- getApp conf return (p, app) yesod-1.2.4/Yesod/Default/Config.hs0000644000000000000000000001765112247534155015261 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} module Yesod.Default.Config ( DefaultEnv (..) , fromArgs , fromArgsSettings , loadDevelopmentConfig -- reexport , AppConfig (..) , ConfigSettings (..) , configSettings , loadConfig , withYamlEnvironment ) where import Data.Char (toUpper, toLower) import Data.Text (Text) import qualified Data.Text as T import Data.Yaml import Data.Maybe (fromMaybe) import qualified Data.HashMap.Strict as M import System.Environment (getArgs, getProgName, getEnvironment) import System.Exit (exitFailure) import Data.Conduit.Network (HostPreference) import Data.String (fromString) -- | 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 env = ArgConfig { environment :: env , port :: Int } deriving Show parseArgConfig :: (Show env, Read env, Enum env, Bounded env) => IO (ArgConfig env) parseArgConfig = do let envs = [minBound..maxBound] args <- getArgs (portS, args') <- getPort id args portI <- case reads portS of (i, _):_ -> return i [] -> error $ "Invalid port value: " ++ show portS case args' of [e] -> do case reads $ capitalize e of (e', _):_ -> return $ ArgConfig e' portI [] -> do () <- error $ "Invalid environment, valid entries are: " ++ show envs -- next line just provided to force the type of envs return $ ArgConfig (head envs) 0 _ -> do pn <- getProgName putStrLn $ "Usage: " ++ pn ++ " [--port ]" putStrLn $ "Valid environments: " ++ show envs exitFailure where getPort front [] = do env <- getEnvironment return (fromMaybe "0" $ lookup "PORT" env, front []) getPort front ("--port":p:rest) = return (p, front rest) getPort front ("-p":p:rest) = return (p, front rest) getPort front (arg:rest) = getPort (front . (arg:)) rest capitalize [] = [] capitalize (x:xs) = toUpper x : xs -- | Load the app config from command line parameters, using the given -- @ConfigSettings. -- -- Since 1.2.2 fromArgsSettings :: (Read env, Show env, Enum env, Bounded env) => (env -> IO (ConfigSettings env extra)) -> IO (AppConfig env extra) fromArgsSettings cs = do args <- parseArgConfig let env = environment args config <- cs env >>= loadConfig env' <- getEnvironment let config' = case lookup "APPROOT" env' of Nothing -> config Just ar -> config { appRoot = T.pack ar } return $ if port args /= 0 then config' { appPort = port args } else config' -- | Load the app config from command line parameters fromArgs :: (Read env, Show env, Enum env, Bounded env) => (env -> Object -> Parser extra) -> IO (AppConfig env extra) fromArgs getExtra = fromArgsSettings $ \env -> return (configSettings env) { csParseExtra = getExtra } -- | Load your development config (when using @'DefaultEnv'@) loadDevelopmentConfig :: IO (AppConfig DefaultEnv ()) loadDevelopmentConfig = loadConfig $ configSettings Development -- | Dynamic per-environment configuration which can be loaded at -- run-time negating the need to recompile between environments. data AppConfig environment extra = AppConfig { appEnv :: environment , appPort :: Int , appRoot :: Text , appHost :: HostPreference , appExtra :: extra } deriving (Show) data ConfigSettings environment extra = ConfigSettings { -- | An arbitrary value, used below, to indicate the current running -- environment. Usually, you will use 'DefaultEnv' for this type. csEnv :: environment -- | Load any extra data, to be used by the application. , csParseExtra :: environment -> Object -> Parser 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 -> Value -> IO Value } -- | Default config settings. configSettings :: Show env => env -> ConfigSettings env () configSettings env0 = ConfigSettings { csEnv = env0 , csParseExtra = \_ _ -> return () , csFile = \_ -> return "config/settings.yml" , 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 (M.lookup tenv envs) } -- | Load an @'AppConfig'@. -- -- Some examples: -- -- > -- typical local development -- > Development: -- > host: localhost -- > port: 3000 -- > -- > -- approot: will default to "" -- -- > -- typical outward-facing production box -- > Production: -- > host: www.example.com -- > -- > -- port: will default 80 -- > -- host: will default to "*" -- > -- approot: will default "http://www.example.com" -- -- > -- maybe you're reverse proxying connections to the running app -- > -- on some other port -- > Production: -- > port: 8080 -- > approot: "http://example.com" -- > host: "localhost" loadConfig :: ConfigSettings environment extra -> IO (AppConfig environment extra) loadConfig (ConfigSettings env parseExtra getFile getObject) = do fp <- getFile env 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" let host = fromString $ T.unpack $ fromMaybe "*" $ lookupScalar "host" m mport <- parseMonad (\x -> x .: "port") m let approot' = fromMaybe "" $ lookupScalar "approot" m -- Handle the DISPLAY_PORT environment variable for yesod devel approot <- case T.stripSuffix ":3000" approot' of Nothing -> return approot' Just prefix -> do envVars <- getEnvironment case lookup "DISPLAY_PORT" envVars of Nothing -> return approot' Just p -> return $ prefix `T.append` T.pack (':' : p) extra <- parseMonad (parseExtra env) m -- set some default arguments let port' = fromMaybe 80 mport return $ AppConfig { appEnv = env , appPort = port' , appRoot = approot , appHost = host , appExtra = extra } 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 -- | Loads the configuration block in the passed file named by the -- passed environment, yields to the passed function as a mapping. -- -- Errors in the case of a bad load or if your function returns -- @Nothing@. withYamlEnvironment :: Show e => FilePath -- ^ the yaml file -> e -- ^ the environment you want to load -> (Value -> Parser a) -- ^ what to do with the mapping -> IO a withYamlEnvironment fp env f = do 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 -> parseMonad f v _ -> fail $ "Could not find environment: " ++ show env