diff --git a/.travis.yml b/.travis.yml index bac77556..90378e8c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,12 +2,9 @@ language: haskell install: - cabal update - - cabal install mega-sdist hspec cabal-meta cabal-src - - git clone https://github.com/snoyberg/tagstream-conduit.git - - cd tagstream-conduit - - cabal-src-install --src-only - - cd .. - - cabal-meta install --force-reinstalls --enable-tests + - cabal install --force-reinstalls mega-sdist hspec cabal-meta cabal-src + - cabal-meta install --force-reinstalls script: - echo Done + - mega-sdist --test diff --git a/README.md b/README.md index afceadd7..7536fb5a 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,6 @@ An advanced web framework using the Haskell programming language. Featuring: * techniques for constant-space memory consumption * asynchronous IO * this is built in to the Haskell programming language (like Erlang) - * handles a greater concurrent load than any other web application server # Learn more: http://yesodweb.com/ @@ -27,18 +26,19 @@ Your application is a cabal package and you use `cabal` to install its dependenc Install conflicts are unfortunately common in Haskell development. If you are not using any sandbox tools, you may discover that some of the other haskell installs on your system are broken. -You can prevent this by using sandbox tools: `cabal-dev` or `hsenv`. +You can prevent this by using cabal sandbox. -Isolating an entire project with a virtual machine is also a great idea, you just need some tools to help that process. -[Vagrant](http://vagrantup.com) is a great tool for that and there is a [Haskell Platform installer](https://bitbucket.org/puffnfresh/vagrant-haskell-heroku) for it. +Isolating an entire project is also a great idea, you just need some tools to help that process. +On Linux you can use Docker. +On any OS you can use a virtual machine. [Vagrant](http://vagrantup.com) is a great tool for that and there is a [Haskell Platform installer](https://bitbucket.org/puffnfresh/vagrant-haskell-heroku) for it. -## Using cabal-dev +## Using cabal sandbox -cabal-dev creates a sandboxed environment for an individual cabal package. -Instead of using the `cabal` command, use the `cabal-dev` command which will use the sandbox. +To sandbox a project, type: -Use `yesod devel --dev` when developing your application. + cabal sandbox init +This ensures that future installs will be local to the sandboxed directory. ## Installing the latest development version from github for use with your application @@ -55,7 +55,7 @@ In your application folder, create a `sources.txt` file with the following conte https://github.com/yesodweb/wai `./` means build your app. The yesod repos will be cloned and placed in a `vendor` repo. -Now run: `cabal-meta install`. If you use `cabal-dev`, run `cabal-meta --dev install` +Now run: `cabal-meta install`. This should work almost all of the time. You can read more on [cabal-meta](https://github.com/yesodweb/cabal-meta) If you aren't building from an application, remove the `./` and create a new directory for your sources.txt first. @@ -64,23 +64,9 @@ If you aren't building from an application, remove the `./` and create a new dir ## hsenv (Linux and Mac OS X) -[hsenv](https://github.com/tmhedberg/hsenv) prevents your custom build of Yesod from interfering with your currently installed cabal packages: +[hsenv](https://github.com/tmhedberg/hsenv) also provides a sandbox, but works at the shell level. +Generally we recommend using cabal sandbox, but hsenv has tools for allowing you to use different versions of GHC, which may be useful for you. -* hsenv creates an isolated environment like cabal-dev -* hsenv works at the shell level, so every shell must activate the hsenv -* cabal-dev by default isolates a single cabal package, but hsenv isolates multiple packages together. -* cabal-dev can isolate multiple packages together by using the -s sandbox argument - - -## cabal-src - -The cabal-src tool helps resolve dependency conflicts when installing local packages. -This capability is already built in if you are using cabal-dev or cabal-meta. Otherwise install cabal-src with: - - cabal install cabal-src - -Whenever you would use `cabal install` to install a local package, use `cabal-src-install` instead. -Our installer script now uses cabal-src-install when it is available. ## Cloning the repos @@ -100,7 +86,7 @@ done ## Building your changes to Yesod -Yesod is composed of 4 "mega-repos", each with multiple cabal packages. `./script/install` will run tests against each package and install each package. +The traditional Yesod stack requires 4 "mega-repos", each with multiple cabal packages. `./script/install` will run tests against each package and install each package. ### install package in all repos diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index 70024aff..e9df5fda 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -172,6 +172,17 @@ class (YesodAuth site, PathPiece (AuthEmailId site)) => YesodAuthEmail site wher setTitleI Msg.ConfirmationEmailSentTitle [whamlet|

_{Msg.ConfirmationEmailSent identifier}|] + -- | Additional normalization of email addresses, besides standard canonicalization. + -- + -- Default: do nothing. Note that in future versions of Yesod, the default + -- will change to lower casing the email address. At that point, you will + -- need to either ensure your database values are migrated to lower case, + -- or change this default back to doing nothing. + -- + -- Since 1.2.3 + normalizeEmailAddress :: site -> Text -> Text + normalizeEmailAddress _ = TS.toLower + authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> @@ -234,7 +245,7 @@ registerHelper allowUsername dest = do loginErrorMessageI dest Msg.NoIdentifierProvided Just x | Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) -> - return $ decodeUtf8With lenientDecode x' + return $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x' | allowUsername -> return $ TS.strip x | otherwise -> do loginErrorMessageI dest Msg.InvalidEmailAddress diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 597d5af2..591ced53 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.2.2.1 +version: 1.2.3 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-bin/GhcBuild.hs b/yesod-bin/GhcBuild.hs index 38913eab..9a1e81f6 100644 --- a/yesod-bin/GhcBuild.hs +++ b/yesod-bin/GhcBuild.hs @@ -39,7 +39,7 @@ import GHC.Paths (libdir) import HscTypes (HscEnv (..), emptyHomePackageTable) import qualified Module import MonadUtils (liftIO) -import Panic (ghcError, panic) +import Panic (throwGhcException, panic) import SrcLoc (Located, mkGeneralLocated) import qualified StaticFlags import StaticFlags (v_Ld_inputs) @@ -234,7 +234,7 @@ parseModeFlags args = do Nothing -> doMakeMode Just (m, _) -> m errs = errs1 ++ map (mkGeneralLocated "on the commandline") errs2 - when (not (null errs)) $ ghcError $ errorsToGhcException errs + when (not (null errs)) $ throwGhcException $ errorsToGhcException errs return (mode, flags' ++ leftover, warns) type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String]) diff --git a/yesod-bin/Options.hs b/yesod-bin/Options.hs index 25b3d940..c180f31b 100644 --- a/yesod-bin/Options.hs +++ b/yesod-bin/Options.hs @@ -71,7 +71,7 @@ injectDefaultP env path p@(OptP o) in parseri { infoParser = injectDefaultP env (path ++ [normalizeName cmd]) (infoParser parseri) } in OptP (Option (CmdReader cmds (`M.lookup` cmdMap)) props) | (Option (OptReader names (CReader _ rdr) _) _) <- o = - p <|> either (const empty) pure (msum $ map (rdr <=< (maybe (Left $ ErrorMsg "Missing environment variable") Right . getEnvValue env path)) names) + p <|> either' (const empty) pure (msum $ map (rdr <=< (maybe (left $ ErrorMsg "Missing environment variable") right . getEnvValue env path)) names) | (Option (FlagReader names a) _) <- o = p <|> if any ((==Just "1") . getEnvValue env path) names then pure a else empty | otherwise = p @@ -81,6 +81,16 @@ injectDefaultP env path (AltP p1 p2) = AltP (injectDefaultP env path p1) (injectDefaultP env path p2) injectDefaultP _env _path b@(BindP {}) = b +#if MIN_VERSION_optparse_applicative(0,6,0) +right = ReadM . Right +left = ReadM . Left +either' f g (ReadM x) = either f g x +#else +right = Right +left = Left +either' = either +#endif + getEnvValue :: M.Map [String] String -> [String] -> OptName -> Maybe String getEnvValue env path (OptLong l) = M.lookup (path ++ [normalizeName l]) env getEnvValue _ _ _ = Nothing diff --git a/yesod-bin/Scaffolding/Scaffolder.hs b/yesod-bin/Scaffolding/Scaffolder.hs index bd055d87..ac015295 100644 --- a/yesod-bin/Scaffolding/Scaffolder.hs +++ b/yesod-bin/Scaffolding/Scaffolder.hs @@ -67,8 +67,9 @@ validPN c validPN '-' = True validPN _ = False -scaffold :: IO () -scaffold = do +scaffold :: Bool -- ^ bare directory instead of a new subdirectory? + -> IO () +scaffold isBare = do puts $ renderTextUrl undefined $(textFile "input/welcome.cg") project <- prompt $ \s -> if all validPN s && not (null s) && s /= "test" @@ -90,7 +91,7 @@ scaffold = do putStrLn "That's it! I'm creating your files now..." let sink = unpackTemplate - (receiveFS $ fromString project) + (receiveFS $ if isBare then "." else fromString project) (T.replace "PROJECTNAME" (T.pack project)) case ebackend of Left req -> withManager $ \m -> do diff --git a/yesod-bin/input/done.cg b/yesod-bin/input/done.cg index b838c2ea..280f3af4 100644 --- a/yesod-bin/input/done.cg +++ b/yesod-bin/input/done.cg @@ -24,9 +24,4 @@ Take part in the community: http://yesodweb.com/page/community Start your project: - cd PROJECTNAME && cabal install && yesod devel - -or if you use cabal-dev: - - cd PROJECTNAME && cabal-dev install && yesod --dev devel - + cd PROJECTNAME && cabal sandbox init && cabal install && yesod devel diff --git a/yesod-bin/main.hs b/yesod-bin/main.hs index 11d6ead3..f0f4e4b0 100755 --- a/yesod-bin/main.hs +++ b/yesod-bin/main.hs @@ -16,6 +16,9 @@ import qualified Paths_yesod_bin import Scaffolding.Scaffolder import Options.Applicative.Builder.Internal (Mod, OptionFields) +#if MIN_VERSION_optparse_applicative(0,6,0) +import Options.Applicative.Types (ReadM (ReadM)) +#endif #ifndef WINDOWS import Build (touch) @@ -42,7 +45,7 @@ data Options = Options } deriving (Show, Eq) -data Command = Init +data Command = Init { _initBare :: Bool } | Configure | Build { buildExtraArgs :: [String] } | Touch @@ -89,7 +92,7 @@ main = do ] optParser' let cabal xs = rawSystem' (cabalCommand o) xs case optCommand o of - Init -> scaffold + Init bare -> scaffold bare Configure -> cabal ["configure"] Build es -> touch' >> cabal ("build":es) Touch -> touch' @@ -109,7 +112,8 @@ optParser :: Parser Options optParser = Options <$> flag Cabal CabalDev ( long "dev" <> short 'd' <> help "use cabal-dev" ) <*> switch ( long "verbose" <> short 'v' <> help "More verbose output" ) - <*> subparser ( command "init" (info (pure Init) + <*> subparser ( command "init" + (info (Init <$> (switch (long "bare" <> help "Create files in current folder"))) (progDesc "Scaffold a new site")) <> command "configure" (info (pure Configure) (progDesc "Configure a project for building")) @@ -164,7 +168,11 @@ optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String) optStr m = nullOption $ value Nothing <> reader (success . str) <> m where +#if MIN_VERSION_optparse_applicative(0,6,0) + success = ReadM . Right +#else success = Right +#endif -- | Like @rawSystem@, but exits if it receives a non-success result. rawSystem' :: String -> [String] -> IO () diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 725fed8e..27110e13 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.3.2 +version: 1.2.4 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs index 84550605..d0c0b383 100644 --- a/yesod-core/Yesod/Core/Json.hs +++ b/yesod-core/Yesod/Core/Json.hs @@ -84,6 +84,10 @@ provideJson = provideRep . return . J.toJSON -- If you want the raw JSON value, just ask for a @'J.Result' -- 'J.Value'@. -- +-- Note that this function will consume the request body. As such, calling it +-- twice will result in a parse error on the second call, since the request +-- body will no longer be available. +-- -- /Since: 0.3.0/ parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) parseJsonBody = do diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs index be977649..a972efad 100644 --- a/yesod-core/Yesod/Core/Widget.hs +++ b/yesod-core/Yesod/Core/Widget.hs @@ -47,6 +47,7 @@ module Yesod.Core.Widget , handlerToWidget -- * Internal , whamletFileWithSettings + , asWidgetT ) where import Data.Monoid diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 41052b8a..10ee5dda 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.4.2 +version: 1.2.5 license: MIT license-file: LICENSE author: Michael Snoyman @@ -41,7 +41,7 @@ library , transformers >= 0.2.2 && < 0.4 , clientsession >= 0.9 && < 0.10 , random >= 1.0.0.2 && < 1.1 - , cereal >= 0.3 && < 0.4 + , cereal >= 0.3 , old-locale >= 1.0.0.2 && < 1.1 , failure >= 0.2 && < 0.3 , containers >= 0.2 @@ -91,6 +91,9 @@ library -- This looks like a GHC bug extensions: MultiParamTypeClasses + -- Workaround for: http://ghc.haskell.org/trac/ghc/ticket/8443 + extensions: TemplateHaskell + test-suite tests type: exitcode-stdio-1.0 main-is: test.hs @@ -118,6 +121,7 @@ test-suite tests , lifted-base , resourcet ghc-options: -Wall + extensions: TemplateHaskell source-repository head type: git diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index d2aecf8a..0689859f 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -36,6 +36,8 @@ module Yesod.Form.Fields , selectFieldList , radioField , radioFieldList + , checkboxesFieldList + , checkboxesField , multiSelectField , multiSelectFieldList , Option (..) @@ -62,8 +64,8 @@ import qualified Text.Email.Validate as Email import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Network.URI (parseURI) -import Database.Persist.Sql (PersistField, PersistFieldSql) -import Database.Persist (Entity (..)) +import Database.Persist.Sql (PersistField, PersistFieldSql (..)) +import Database.Persist (Entity (..), SqlType (SqlString)) import Text.HTML.SanitizeXSS (sanitizeBalance) import Control.Monad (when, unless) import Data.Maybe (listToMaybe, fromMaybe) @@ -166,7 +168,9 @@ $newline never -- | A newtype wrapper around a 'Text' that converts newlines to HTML -- br-tags. newtype Textarea = Textarea { unTextarea :: Text } - deriving (Show, Read, Eq, PersistField, PersistFieldSql, Ord) + deriving (Show, Read, Eq, PersistField, Ord) +instance PersistFieldSql Textarea where + sqlType _ = SqlString instance ToHtml Textarea where toHtml = unsafeByteString @@ -388,6 +392,28 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) -> Field (HandlerT site IO) a radioFieldList = radioField . optionsPairs +checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] + -> Field (HandlerT site IO) [a] +checkboxesFieldList = checkboxesField . optionsPairs + +checkboxesField :: (Eq a, RenderMessage site FormMessage) + => HandlerT site IO (OptionList a) + -> Field (HandlerT site IO) [a] +checkboxesField ioptlist = (multiSelectField ioptlist) + { fieldView = + \theId name attrs val isReq -> do + opts <- fmap olOptions $ handlerToWidget ioptlist + let optselected (Left _) _ = False + optselected (Right vals) opt = (optionInternalValue opt) `elem` vals + [whamlet| + + $forall opt <- opts +

Hello +-- >

Check the +-- > compile time +-- >|] +-- > +-- >main :: IO () +-- >main = warp 3000 $ MyApp eStatic diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs new file mode 100644 index 00000000..0882c16d --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +module Yesod.EmbeddedStatic.Internal ( + EmbeddedStatic(..) + , Route(..) + , ComputedEntry(..) + , devEmbed + , prodEmbed + , develApp + , AddStaticContent + , staticContentHelper + , widgetSettings +) where + +import Control.Applicative ((<$>)) +import Data.IORef +import Language.Haskell.TH +import Network.HTTP.Types (Status(..), status404, status200, status304) +import Network.Mime (MimeType) +import Network.Wai +import Network.Wai.Application.Static (defaultWebAppSettings, staticApp) +import WaiAppStatic.Types +import Yesod.Core + ( HandlerT + , ParseRoute(..) + , RenderRoute(..) + , Yesod(..) + , getYesod + , liftIO + ) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.HashMap.Strict as M +import qualified WaiAppStatic.Storage.Embedded as Static + +import Yesod.Static (base64md5) +import Yesod.EmbeddedStatic.Types + +#if !MIN_VERSION_base(4,6,0) +-- copied from base +atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b +atomicModifyIORef' ref f = do + b <- atomicModifyIORef ref + (\x -> let (a, b) = f x + in (a, a `seq` b)) + b `seq` return b +#endif + +-- | The subsite for the embedded static file server. +data EmbeddedStatic = EmbeddedStatic { + stApp :: !Application + , widgetFiles :: !(IORef (M.HashMap T.Text File)) +} + +instance RenderRoute EmbeddedStatic where + data Route EmbeddedStatic = EmbeddedResourceR [T.Text] [(T.Text,T.Text)] + | EmbeddedWidgetR T.Text + deriving (Eq, Show, Read) + renderRoute (EmbeddedResourceR x y) = ("res":x, y) + renderRoute (EmbeddedWidgetR h) = (["widget",h], []) +instance ParseRoute EmbeddedStatic where + parseRoute (("res":x), y) = Just $ EmbeddedResourceR x y + parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h + parseRoute _ = Nothing + +-- | At compile time, one of these is created for every 'Entry' created by +-- the generators. The cLink is a template haskell expression of type @Route EmbeddedStatic@. +data ComputedEntry = ComputedEntry { + cHaskellName :: Maybe Name -- ^ Optional haskell name to create a variable for the route + , cStEntry :: Static.EmbeddableEntry -- ^ The entry to be embedded into the executable + , cLink :: ExpQ -- ^ The route for this entry +} + +mkStr :: String -> ExpQ +mkStr = litE . stringL + +-- | Create a 'ComputedEntry' for development mode, reloading the content on every request. +devEmbed :: Entry -> IO ComputedEntry +devEmbed e = return computed + where + st = Static.EmbeddableEntry { + Static.eLocation = "res/" `T.append` T.pack (ebLocation e) + , Static.eMimeType = ebMimeType e + , Static.eContent = Right [| $(ebDevelReload e) >>= \c -> + return (T.pack (base64md5 c), c) |] + } + link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |] + computed = ComputedEntry (ebHaskellName e) st link + +-- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable. +prodEmbed :: Entry -> IO ComputedEntry +prodEmbed e = do + ct <- ebProductionContent e + let hash = base64md5 ct + link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) + [(T.pack "etag", T.pack $(mkStr hash))] |] + st = Static.EmbeddableEntry { + Static.eLocation = "res/" `T.append` T.pack (ebLocation e) + , Static.eMimeType = ebMimeType e + , Static.eContent = Left (T.pack hash, ct) + } + return $ ComputedEntry (ebHaskellName e) st link + +tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application +tryExtraDevelFiles [] _ = return $ responseLBS status404 [] "" +tryExtraDevelFiles (f:fs) r = do + mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res" + case mct of + Nothing -> tryExtraDevelFiles fs r + Just (mime, ct) -> do + let hash = T.encodeUtf8 $ T.pack $ base64md5 ct + let headers = [ ("Content-Type", mime) + , ("ETag", hash) + ] + case lookup "If-None-Match" (requestHeaders r) of + Just h | hash == h -> return $ responseLBS status304 headers "" + _ -> return $ responseLBS status200 headers ct + +-- | Helper to create the development application at runtime +develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application +develApp settings extra req = do + resp <- staticApp settings {ssMaxAge = NoMaxAge} req + if statusCode (responseStatus resp) == 404 + then tryExtraDevelFiles extra req + else return resp + +-- | The type of 'addStaticContent' +type AddStaticContent site = T.Text -> T.Text -> BL.ByteString + -> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)]))) + +-- | Helper for embedStaticContent and embedLicensedStaticContent. +staticContentHelper :: Yesod site + => (site -> EmbeddedStatic) + -> (Route EmbeddedStatic -> Route site) + -> (BL.ByteString -> Either a BL.ByteString) + -> AddStaticContent site +staticContentHelper getStatic staticR minify ext _ ct = do + wIORef <- widgetFiles . getStatic <$> getYesod + let hash = T.pack $ base64md5 ct + hash' = Just $ T.encodeUtf8 hash + filename = T.concat [hash, ".", ext] + content = case ext of + "js" -> either (const ct) id $ minify ct + _ -> ct + file = File + { fileGetSize = fromIntegral $ BL.length content + , fileToResponse = \s h -> responseLBS s h content + , fileName = unsafeToPiece filename + , fileGetHash = return hash' + , fileGetModified = Nothing + } + liftIO $ atomicModifyIORef' wIORef $ \m -> + (M.insertWith (\old _ -> old) filename file m, ()) + + return $ Just $ Right (staticR $ EmbeddedWidgetR filename, []) + +-- | Create a wai-app-static settings based on the IORef inside the EmbeddedStaic site. +widgetSettings :: EmbeddedStatic -> StaticSettings +widgetSettings es = (defaultWebAppSettings "") { ssLookupFile = lookupFile } + where + lookupFile [_,p] = do -- The first part of the path is "widget" + m <- readIORef $ widgetFiles es + return $ maybe LRNotFound LRFile $ M.lookup (fromPiece p) m + lookupFile _ = return LRNotFound diff --git a/yesod-static/Yesod/EmbeddedStatic/Types.hs b/yesod-static/Yesod/EmbeddedStatic/Types.hs new file mode 100644 index 00000000..5cbd662f --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Types.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module Yesod.EmbeddedStatic.Types( + Location + , Generator + -- ** Entry + , Entry + , ebHaskellName + , ebLocation + , ebMimeType + , ebProductionContent + , ebDevelReload + , ebDevelExtraFiles +) where + +import Data.Default +import Language.Haskell.TH +import Network.Mime (MimeType) +import qualified Data.ByteString.Lazy as BL + +-- | A location is a relative path within the static subsite at which resource(s) are made available. +-- The location can include slashes to simulate directories but must not start or end with a slash. +type Location = String + +-- | A single resource embedded into the executable at compile time. +-- +-- This data type is a settings type. For more information, see +-- . +data Entry = Entry { + ebHaskellName :: Maybe Name + -- ^ An optional haskell name. If the name is present, a variable + -- of type @Route 'Yesod.EmbeddedStatic.EmbeddedStatic'@ with the + -- given name will be created which points to this resource. + , ebLocation :: Location -- ^ The location to serve the resource from. + , ebMimeType :: MimeType -- ^ The mime type of the resource. + , ebProductionContent :: IO BL.ByteString + -- ^ If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is False, + -- then at compile time this action will be executed to load the content. + -- During development, this action will not be executed. + , ebDevelReload :: ExpQ + -- ^ This must be a template haskell expression of type @IO 'BL.ByteString'@. + -- If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is True, + -- this action is executed on every request to compute the content. Most of the + -- time, 'ebProductionContent' and 'ebDevelReload' should be the same action but + -- occasionally you might want additional processing inside the 'ebProductionContent' + -- function like javascript/css minification to only happen when building for production. + , ebDevelExtraFiles :: Maybe ExpQ + -- ^ Occasionally, during development an entry needs extra files/resources available + -- that are not present during production (for example, image files that are embedded + -- into the CSS at production but left unembedded during development). If present, + -- @ebDevelExtraFiles@ must be a template haskell expression of type + -- @['T.Text'] -> IO (Maybe ('MimeType', 'BL.ByteString'))@. That is, a function + -- taking as input the list of path pieces and optionally returning a mime type + -- and content. +} + +-- | When using 'def', you must fill in at least 'ebLocation'. +instance Default Entry where + def = Entry { ebHaskellName = Nothing + , ebLocation = "xxxx" + , ebMimeType = "application/octet-stream" + , ebProductionContent = return BL.empty + , ebDevelReload = [| return BL.empty |] + , ebDevelExtraFiles = Nothing + } + +-- | An embedded generator is executed at compile time to produce the entries to embed. +type Generator = Q [Entry] diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index c8949f17..85e95e87 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -35,7 +35,6 @@ module Yesod.Static -- * Smart constructor , static , staticDevel - , embed -- * Combining CSS/JS -- $combining , combineStylesheets' @@ -54,6 +53,8 @@ module Yesod.Static , publicFiles -- * Hashing , base64md5 + -- * Embed + , embed #ifdef TEST_EXPORT , getFileListPieces #endif @@ -134,8 +135,11 @@ staticDevel dir = do hashLookup <- cachedETagLookupDevel dir return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup --- | Produce a 'Static' based on embedding all of the static --- files' contents in the executable at compile time. +-- | Produce a 'Static' based on embedding all of the static files' contents in the +-- executable at compile time. +-- +-- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful. +-- -- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs -- you will need to change the scaffolded addStaticContent. Otherwise, some of your -- assets will be 404'ed. This is because by default yesod will generate compile those diff --git a/yesod-static/sample-embed.hs b/yesod-static/sample-embed.hs index b8a53b3b..cb1cc4d5 100644 --- a/yesod-static/sample-embed.hs +++ b/yesod-static/sample-embed.hs @@ -1,23 +1,42 @@ -{-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -import Yesod.Static -import Yesod.Dispatch +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-} +-- | This embeds just a single file; it embeds the source code file +-- \"sample-embed.hs\" from the current directory so when you compile, +-- the sample-embed.hs file must be in the current directory. +-- +-- Try toggling the development argument to 'mkEmbeddedStatic'. When the +-- development argument is true the file \"sample-embed.hs\" is reloaded +-- from disk on every request (try changing it after you start the server). +-- When development is false, the contents are embedded and the sample-embed.hs +-- file does not even need to be present during runtime. +module Main where + import Yesod.Core -import Network.Wai.Handler.Warp (run) +import Yesod.EmbeddedStatic -staticFiles "." +mkEmbeddedStatic False "eStatic" [embedFile "sample-embed.hs"] -data Sample = Sample -getStatic _ = $(embed "tests") -mkYesod "Sample" [parseRoutes| -/ RootR GET -/static StaticR Static getStatic +-- The above will generate variables +-- eStatic :: EmbeddedStatic +-- sample_embed_hs :: Route EmbeddedStatic + +data MyApp = MyApp { getStatic :: EmbeddedStatic } + +mkYesod "MyApp" [parseRoutes| +/ HomeR GET +/static StaticR EmbeddedStatic getStatic |] -instance Yesod Sample where approot _ = "" -getRootR = do - redirectText RedirectPermanent "static" - return () +instance Yesod MyApp where + addStaticContent = embedStaticContent getStatic StaticR Right -main = toWaiApp Sample >>= run 3000 +getHomeR :: Handler Html +getHomeR = defaultLayout $ do + toWidget [julius|console.log("Hello World");|] + [whamlet| +

Hello +

Check the + embedded file +|] + +main :: IO () +main = warp 3000 $ MyApp eStatic diff --git a/yesod-static/test/EmbedDevelTest.hs b/yesod-static/test/EmbedDevelTest.hs new file mode 100644 index 00000000..f1436614 --- /dev/null +++ b/yesod-static/test/EmbedDevelTest.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-} +module EmbedDevelTest where + +-- Tests the development mode of the embedded static subsite by +-- using a custom generator testGen. + +import Data.Maybe (isNothing) +import EmbedTestGenerator +import EmbedProductionTest (findEtag) +import Network.Wai.Test (SResponse(simpleHeaders)) +import Test.HUnit (assertBool) +import Test.Hspec (Spec) +import Yesod.Core +import Yesod.EmbeddedStatic +import Yesod.Test + +mkEmbeddedStatic True "eDev" [testGen] + +data MyApp = MyApp { getStatic :: EmbeddedStatic } + +mkYesod "MyApp" [parseRoutes| +/static StaticR EmbeddedStatic getStatic +|] + +instance Yesod MyApp + +noCacheControl :: YesodExample site () +noCacheControl = withResponse $ \r -> do + liftIO $ assertBool "Cache-Control exists" $ + isNothing $ lookup "Cache-Control" $ simpleHeaders r + liftIO $ assertBool "Expires exists" $ + isNothing $ lookup "Expires" $ simpleHeaders r + +embedDevSpecs :: Spec +embedDevSpecs = yesodSpec (MyApp eDev) $ do + ydescribe "Embedded Development Entries" $ do + yit "e1 loads" $ do + get $ StaticR e1 + statusIs 200 + assertHeader "Content-Type" "text/plain" + noCacheControl + bodyEquals "e1 devel" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR e1 + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e2 with simulated directory" $ do + get $ StaticR e2 + statusIs 200 + assertHeader "Content-Type" "abcdef" + noCacheControl + bodyEquals "e2 devel" + + yit "e3 without haskell name" $ do + get $ StaticR $ embeddedResourceR ["xxxx", "e3"] [] + statusIs 200 + assertHeader "Content-Type" "yyy" + noCacheControl + bodyEquals "e3 devel" + + yit "e4 loads" $ do + get $ StaticR e4 + statusIs 200 + assertHeader "Content-Type" "text/plain" + noCacheControl + bodyEquals "e4 devel" + + yit "e4 extra development dev1" $ do + get $ StaticR $ embeddedResourceR ["dev1"] [] + statusIs 200 + assertHeader "Content-Type" "mime" + noCacheControl + bodyEquals "dev1 content" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR $ embeddedResourceR ["dev1"] [] + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e4 extra development with path" $ do + get $ StaticR $ embeddedResourceR ["dir", "dev2"] [] + statusIs 200 + assertHeader "Content-Type" "mime2" + noCacheControl + bodyEquals "dev2 content" + + yit "extra development file 404" $ do + get $ StaticR $ embeddedResourceR ["xxxxxxxxxx"] [] + statusIs 404 diff --git a/yesod-static/test/EmbedProductionTest.hs b/yesod-static/test/EmbedProductionTest.hs new file mode 100644 index 00000000..d7fcbc1d --- /dev/null +++ b/yesod-static/test/EmbedProductionTest.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-} +module EmbedProductionTest where + +-- Tests the production mode of the embedded static subsite by +-- using a custom generator testGen. Also tests that the widget +-- content is embedded properly. + +import Data.Maybe (isJust) +import EmbedTestGenerator +import Network.Wai.Test (SResponse(simpleHeaders)) +import Test.HUnit (assertFailure, assertBool) +import Test.Hspec (Spec) +import Yesod.Core +import Yesod.EmbeddedStatic +import Yesod.Test +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +mkEmbeddedStatic False "eProduction" [testGen] + +data MyApp = MyApp { getStatic :: EmbeddedStatic } + +mkYesod "MyApp" [parseRoutes| +/ HomeR GET +/static StaticR EmbeddedStatic getStatic +|] + +getHomeR :: Handler Html +getHomeR = defaultLayout $ do + toWidget [julius|console.log("Hello World");|] + [whamlet|

Hello|] + +instance Yesod MyApp where + addStaticContent = embedStaticContent getStatic StaticR Right + +findEtag :: YesodExample site B.ByteString +findEtag = withResponse $ \r -> + case lookup "ETag" (simpleHeaders r) of + Nothing -> liftIO (assertFailure "No etag found") >> error "" + Just e -> return e + +hasCacheControl :: YesodExample site () +hasCacheControl = withResponse $ \r -> do + liftIO $ assertBool "Cache-Control missing" $ + isJust $ lookup "Cache-Control" $ simpleHeaders r + liftIO $ assertBool "Expires missing" $ + isJust $ lookup "Expires" $ simpleHeaders r + +embedProductionSpecs :: Spec +embedProductionSpecs = yesodSpec (MyApp eProduction) $ do + ydescribe "Embedded Production Entries" $ do + yit "e1 loads" $ do + get $ StaticR e1 + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e1 production" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR e1 + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e1 with custom built path" $ do + get $ StaticR $ embeddedResourceR ["e1"] [] + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e1 production" + + yit "e2 with simulated directory" $ do + get $ StaticR e2 + statusIs 200 + assertHeader "Content-Type" "abcdef" + hasCacheControl + bodyEquals "e2 production" + + yit "e2 with custom built directory path" $ do + get $ StaticR $ embeddedResourceR ["dir", "e2"] [] + statusIs 200 + assertHeader "Content-Type" "abcdef" + hasCacheControl + bodyEquals "e2 production" + + yit "e3 without haskell name" $ do + get $ StaticR $ embeddedResourceR ["xxxx", "e3"] [] + statusIs 200 + assertHeader "Content-Type" "yyy" + hasCacheControl + bodyEquals "e3 production" + + yit "e4 is embedded" $ do + get $ StaticR e4 + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e4 production" + + yit "e4 extra development files are not embedded" $ do + get $ StaticR $ embeddedResourceR ["dev1"] [] + statusIs 404 + + ydescribe "Embedded Widget Content" $ + yit "Embedded Javascript" $ do + get HomeR + statusIs 200 + [script] <- htmlQuery "script" + let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is " + + get $ TL.toStrict $ TL.decodeUtf8 src + statusIs 200 + hasCacheControl + assertHeader "Content-Type" "application/javascript" + bodyEquals "console.log(\"Hello World\");" diff --git a/yesod-static/test/EmbedTestGenerator.hs b/yesod-static/test/EmbedTestGenerator.hs new file mode 100644 index 00000000..633a059b --- /dev/null +++ b/yesod-static/test/EmbedTestGenerator.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module EmbedTestGenerator (testGen) where + +import Data.Default +import Network.Mime (MimeType) +import Yesod.EmbeddedStatic.Types +import Yesod.EmbeddedStatic.Generators (pathToName) + +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.ByteString.Lazy as BL + +e1, e2, e3, e4 :: Entry + +-- Basic entry +e1 = def + { ebHaskellName = Just $ pathToName "e1" + , ebLocation = "e1" + , ebMimeType = "text/plain" + , ebProductionContent = return $ TL.encodeUtf8 "e1 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e1 devel" |] + , ebDevelExtraFiles = Nothing + } + +-- Test simulated directory in location +e2 = def + { ebHaskellName = Just $ pathToName "e2" + , ebLocation = "dir/e2" + , ebMimeType = "abcdef" + , ebProductionContent = return $ TL.encodeUtf8 "e2 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e2 devel" |] + , ebDevelExtraFiles = Nothing + } + +-- Test empty haskell name +e3 = def + { ebHaskellName = Nothing + , ebLocation = "xxxx/e3" + , ebMimeType = "yyy" + , ebProductionContent = return $ TL.encodeUtf8 "e3 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e3 devel" |] + , ebDevelExtraFiles = Nothing + } + +devExtra :: [T.Text] -> IO (Maybe (MimeType, BL.ByteString)) +devExtra ["dev1"] = return $ Just ("mime", "dev1 content") +devExtra ["dir", "dev2"] = return $ Just ("mime2", "dev2 content") +devExtra _ = return Nothing + +-- Entry with devel extra files +e4 = def + { ebHaskellName = Just $ pathToName "e4" + , ebLocation = "e4" + , ebMimeType = "text/plain" + , ebProductionContent = return $ TL.encodeUtf8 "e4 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e4 devel" |] + , ebDevelExtraFiles = Just [| devExtra |] + } + +testGen :: Generator +testGen = return [e1, e2, e3, e4] diff --git a/yesod-static/test/FileGeneratorTests.hs b/yesod-static/test/FileGeneratorTests.hs new file mode 100644 index 00000000..d1bffa34 --- /dev/null +++ b/yesod-static/test/FileGeneratorTests.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module FileGeneratorTests (fileGenSpecs) where + +import Control.Exception +import Control.Monad (forM_) +import GeneratorTestUtil +import Test.Hspec +import Test.HUnit (assertFailure, assertEqual) +import Yesod.EmbeddedStatic.Generators +import qualified Data.ByteString.Lazy as BL + +-- | Embeds the LICENSE file +license :: GenTestResult +license = $(embedFile "LICENSE" >>= + testOneEntry (Just "_LICENSE") "LICENSE" (BL.readFile "LICENSE") + ) + +licenseAt :: GenTestResult +licenseAt = $(embedFileAt "abc.txt" "LICENSE" >>= + testOneEntry (Just "abc_txt") "abc.txt" (BL.readFile "LICENSE") + ) + +embDir :: [GenTestResult] +embDir = $(embedDir "test/embed-dir" >>= + testEntries + [ (Just "abc_def_txt", "abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt") + , (Just "lorem_txt", "lorem.txt", BL.readFile "test/embed-dir/lorem.txt") + , (Just "foo", "foo", BL.readFile "test/embed-dir/foo") + ] + ) + +embDirAt :: [GenTestResult] +embDirAt = $(embedDirAt "xxx" "test/embed-dir" >>= + testEntries + [ (Just "xxx_abc_def_txt", "xxx/abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt") + , (Just "xxx_lorem_txt", "xxx/lorem.txt", BL.readFile "test/embed-dir/lorem.txt") + , (Just "xxx_foo", "xxx/foo", BL.readFile "test/embed-dir/foo") + ] + ) + +concatR :: GenTestResult +concatR = $(concatFiles "out.txt" [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>= + testOneEntry (Just "out_txt") "out.txt" (return "Yesod Rocks\nBar\n") + ) + +-- The transform function should only run at compile for the production content +concatWithR :: GenTestResult +concatWithR = $(concatFilesWith "out2.txt" + (\x -> return $ x `BL.append` "Extra") + [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>= + testOneEntry (Just "out2_txt") "out2.txt" (return "Yesod Rocks\nBar\nExtra") + ) + +fileGenSpecs :: Spec +fileGenSpecs = do + describe "Embed File" $ do + it "embeds a single file" $ + assertGenResult (BL.readFile "LICENSE") license + it "embeds a single file at a location" $ + assertGenResult (BL.readFile "LICENSE") licenseAt + + describe "Embed Directory" $ do + it "embeds a directory" $ + forM_ [embDir, embDirAt] $ \d -> case d of + [GenError e] -> assertFailure e + [def, foo, lorem] -> do + assertGenResult (BL.readFile "test/embed-dir/abc/def.txt") def + assertGenResult (BL.readFile "test/embed-dir/foo") foo + assertGenResult (BL.readFile "test/embed-dir/lorem.txt") lorem + _ -> assertFailure "Bad directory list" + + describe "Concat Files" $ do + it "simple concat" $ + assertGenResult (return "Yesod Rocks\nBar\n") concatR + it "concat with processing function" $ + assertGenResult (return "Yesod Rocks\nBar\n") concatWithR -- no Extra since this is development + + describe "Compress" $ do + it "compress tool function" $ do + out <- compressTool "runhaskell" [] "main = putStrLn \"Hello World\"" + assertEqual "" "Hello World\n" out + + it "tryCompressTools" $ do + out <- flip tryCompressTools "abcdef" + [ const $ throwIO $ ErrorCall "An expected error" + , const $ return "foo" + , const $ return "bar" + ] + assertEqual "" "foo" out + out2 <- flip tryCompressTools "abcdef" + [ const $ throwIO $ ErrorCall "An expected error"] + assertEqual "" "abcdef" out2 diff --git a/yesod-static/test/GeneratorTestUtil.hs b/yesod-static/test/GeneratorTestUtil.hs new file mode 100644 index 00000000..87f744ad --- /dev/null +++ b/yesod-static/test/GeneratorTestUtil.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module GeneratorTestUtil where + +import Control.Applicative +import Control.Monad (when) +import Data.List (sortBy) +import Language.Haskell.TH +import Test.HUnit +import Yesod.EmbeddedStatic.Types +import qualified Data.ByteString.Lazy as BL + +-- We test the generators by executing them at compile time +-- and sticking the result into the GenTestResult. We then +-- test the GenTestResult at runtime. But to test the ebDevelReload +-- we must run the action at runtime so that is also embedded. +-- Because of template haskell stage restrictions, this code +-- needs to be in a separate module. + +data GenTestResult = GenError String + | GenSuccessWithDevel (IO BL.ByteString) + +-- | Creates a GenTestResult at compile time by testing the entry. +testEntry :: Maybe String -> Location -> IO BL.ByteString -> Entry -> ExpQ +testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) = + [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e) + ++ " /= " + ++ $(litE $ stringL $ show name)) |] +testEntry _ loc _ e | ebLocation e /= loc = + [| GenError ("location " ++ $(litE $ stringL $ show $ ebLocation e)) |] +testEntry _ _ act e = do + expected <- runIO act + actual <- runIO $ ebProductionContent e + if expected == actual + then [| GenSuccessWithDevel $(ebDevelReload e) |] + else [| GenError "production content" |] + +testOneEntry :: Maybe String -> Location -> IO BL.ByteString -> [Entry] -> ExpQ +testOneEntry name loc ct [e] = testEntry name loc ct e +testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |] + +-- | Tests a list of entries +testEntries :: [(Maybe String, Location, IO BL.ByteString)] -> [Entry] -> ExpQ +testEntries a b | length a /= length b = [| [GenError "lengths differ"] |] +testEntries a b = listE $ zipWith f a' b' + where + a' = sortBy (\(_,l1,_) (_,l2,_) -> compare l1 l2) a + b' = sortBy (\e1 e2 -> ebLocation e1 `compare` ebLocation e2) b + f (name, loc, ct) e = testEntry name loc ct e + +-- | Use this at runtime to assert the 'GenTestResult' is OK +assertGenResult :: (IO BL.ByteString) -- ^ expected development content + -> GenTestResult -- ^ test result created at compile time + -> Assertion +assertGenResult _ (GenError e) = assertFailure ("invalid " ++ e) +assertGenResult mexpected (GenSuccessWithDevel mactual) = do + expected <- mexpected + actual <- mactual + when (expected /= actual) $ + assertFailure "invalid devel content" diff --git a/yesod-static/test/embed-dir/abc/def.txt b/yesod-static/test/embed-dir/abc/def.txt new file mode 100644 index 00000000..89f4668d --- /dev/null +++ b/yesod-static/test/embed-dir/abc/def.txt @@ -0,0 +1 @@ +Yesod Rocks diff --git a/yesod-static/test/embed-dir/foo b/yesod-static/test/embed-dir/foo new file mode 100644 index 00000000..ebd7525b --- /dev/null +++ b/yesod-static/test/embed-dir/foo @@ -0,0 +1 @@ +Bar diff --git a/yesod-static/test/embed-dir/lorem.txt b/yesod-static/test/embed-dir/lorem.txt new file mode 100644 index 00000000..1bb51996 --- /dev/null +++ b/yesod-static/test/embed-dir/lorem.txt @@ -0,0 +1,6 @@ +Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor +incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis +nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. +Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu +fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in +culpa qui officia deserunt mollit anim id est laborum. diff --git a/yesod-static/test/tests.hs b/yesod-static/test/tests.hs index 00553511..11a124c6 100644 --- a/yesod-static/test/tests.hs +++ b/yesod-static/test/tests.hs @@ -2,6 +2,13 @@ import Test.Hspec import YesodStaticTest (specs) +import EmbedProductionTest (embedProductionSpecs) +import EmbedDevelTest (embedDevSpecs) +import FileGeneratorTests (fileGenSpecs) main :: IO () -main = hspec specs +main = hspec $ do + specs + embedProductionSpecs + embedDevSpecs + fileGenSpecs diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index ffbbc39d..6f3f6f42 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.2.0.1 +version: 1.2.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -12,12 +12,16 @@ build-type: Simple homepage: http://www.yesodweb.com/ description: Static file serving subsite for Yesod Web Framework. extra-source-files: - test/YesodStaticTest.hs - test/tests.hs + sample.hs + sample-embed.hs + test/*.hs test/fs/bar/baz test/fs/tmp/ignored test/fs/.ignored test/fs/foo + test/embed-dir/foo + test/embed-dir/lorem.txt + test/embed-dir/abc/def.txt library build-depends: base >= 4 && < 5 @@ -30,7 +34,7 @@ library , template-haskell , directory >= 1.0 , transformers >= 0.2.2 - , wai-app-static >= 1.3 + , wai-app-static >= 1.3.2 , wai >= 1.3 , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5 @@ -43,8 +47,22 @@ library , system-fileio >= 0.3 , data-default , shakespeare-css >= 1.0.3 + , mime-types >= 0.1 + , hjsmin + , process-conduit >= 1.0 && < 1.1 + , filepath >= 1.3 + , resourcet >= 0.4 + , unordered-containers >= 0.2 + exposed-modules: Yesod.Static + Yesod.EmbeddedStatic + Yesod.EmbeddedStatic.Generators + Yesod.EmbeddedStatic.Types + + other-modules: Yesod.EmbeddedStatic.Internal + ghc-options: -Wall + extensions: TemplateHaskell test-suite tests hs-source-dirs: ., test @@ -53,6 +71,10 @@ test-suite tests cpp-options: -DTEST_EXPORT build-depends: base , hspec >= 1.3 + , yesod-test >= 1.2 + , wai-test + , HUnit + -- copy from above , containers , old-time @@ -76,8 +98,15 @@ test-suite tests , system-fileio , data-default , shakespeare-css + , mime-types + , hjsmin + , process-conduit + , filepath + , resourcet + , unordered-containers ghc-options: -Wall + extensions: TemplateHaskell source-repository head type: git diff --git a/yesod/Yesod/Default/Config.hs b/yesod/Yesod/Default/Config.hs index a1619053..b256cc2a 100644 --- a/yesod/Yesod/Default/Config.hs +++ b/yesod/Yesod/Default/Config.hs @@ -70,7 +70,7 @@ parseArgConfig = do getPort front (arg:rest) = getPort (front . (arg:)) rest capitalize [] = [] - capitalize (x:xs) = toUpper x : map toLower xs + capitalize (x:xs) = toUpper x : xs -- | Load the app config from command line parameters, using the given -- @ConfigSettings. diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 1c22f18a..9c6bf504 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.2.2.1 +version: 1.2.3 license: MIT license-file: LICENSE author: Michael Snoyman