diff --git a/CLI/skel/App.hs b/CLI/skel/App.hs
deleted file mode 100644
index 9b1a37d9..00000000
--- a/CLI/skel/App.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-import Yesod
-import Yesod.Helpers.Static
-import qualified Data.Object.Yaml
-import qualified Safe.Failure
-
-data $Datatype$ = $Datatype$
- { settings :: Settings
- , templateGroup :: TemplateGroup
- }
-
-data Settings = Settings
- { sApproot :: String
- , staticRoot :: String
- , staticDir :: String
- , templateDir :: String
- , portNumber :: Int
- }
-
-settingsFile :: FilePath
-settingsFile = "settings.yaml"
-
-loadSettings :: IO Settings
-loadSettings = do
- m <- Data.Object.Yaml.decodeFile settingsFile >>= fromMapping
- ar <- lookupScalar "approot" m
- sr <- lookupScalar "static-root" m
- sd <- lookupScalar "static-dir" m
- td <- lookupScalar "template-dir" m
- pn <- lookupScalar "port" m >>= Safe.Failure.read
- return \$ Settings ar sr sd td pn
-
-load$Datatype$ :: IO $Datatype$
-load$Datatype$ = do
- s <- loadSettings
- tg <- loadTemplateGroup \$ templateDir s
- return \$ $Datatype$ s tg
-
-main :: IO ()
-main = do
- datatype <- load$Datatype$
- app <- toWaiApp datatype
- basicHandler (portNumber \$ settings datatype) app
-
-instance Yesod $Datatype$ where
- resources = [\$mkResources|
-/:
- GET: homepageH
-/static/*: serveStatic'
-|]
- applyLayout = defaultApplyLayout
-
-instance YesodApproot $Datatype$ where
- approot = sApproot . settings
-
-instance YesodTemplate $Datatype$ where
- getTemplateGroup = templateGroup
- defaultTemplateAttribs y _ = return
- . setHtmlAttrib "approot" (approot y)
- . setHtmlAttrib "staticroot" (staticRoot \$ settings y)
-
-homepageH :: Handler $Datatype$ RepHtml
-homepageH = templateHtml "homepage" return
-
-serveStatic' :: Method -> [String]
- -> Handler $Datatype$ [(ContentType, Content)]
-serveStatic' method pieces = do
- y <- getYesod
- let sd = staticDir \$ settings y
- serveStatic (fileLookupDir sd) method pieces
diff --git a/CLI/skel/LICENSE b/CLI/skel/LICENSE
deleted file mode 100644
index 29ed9276..00000000
--- a/CLI/skel/LICENSE
+++ /dev/null
@@ -1,25 +0,0 @@
-The following license covers this documentation, and the source code, except
-where otherwise indicated.
-
-Copyright $year$, $author$. 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.
diff --git a/CLI/skel/settings.yaml b/CLI/skel/settings.yaml
deleted file mode 100644
index e98384d4..00000000
--- a/CLI/skel/settings.yaml
+++ /dev/null
@@ -1,5 +0,0 @@
-approot: http://localhost:3000/
-static-root: http://localhost:3000/static/
-static-dir: static
-template-dir: templates
-port: 3000
diff --git a/CLI/skel/static/style.css b/CLI/skel/static/style.css
deleted file mode 100644
index d5de60d6..00000000
--- a/CLI/skel/static/style.css
+++ /dev/null
@@ -1,10 +0,0 @@
-html {
- background: #ccc;
-}
-body {
- width: 760px;
- margin: 10px auto;
- padding: 10px;
- border: 1px solid #333;
- background: #fff;
-}
diff --git a/CLI/skel/templates/homepage.st b/CLI/skel/templates/homepage.st
deleted file mode 100644
index fffa55d9..00000000
--- a/CLI/skel/templates/homepage.st
+++ /dev/null
@@ -1,7 +0,0 @@
-\$layout(
- title={Homepage};
- content={
-
Homepage
-
You probably want to put your own content here.
- }
-)\$
diff --git a/CLI/skel/templates/layout.st b/CLI/skel/templates/layout.st
deleted file mode 100644
index fadca393..00000000
--- a/CLI/skel/templates/layout.st
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
- \$title\$
-
- \$extrahead\$
-
-
- \$content\$
-
-
diff --git a/CLI/skel/webapp.cabal b/CLI/skel/webapp.cabal
deleted file mode 100644
index 0fe22111..00000000
--- a/CLI/skel/webapp.cabal
+++ /dev/null
@@ -1,21 +0,0 @@
-name: $project$
-version: 0.0.0
-license: BSD3
-license-file: LICENSE
-author: $author$ $email$
-maintainer: $author$ $email$
-synopsis: A web application based on Yesod.
-description: The default web application. You might want to change this.
-category: Web
-stability: Stable
-cabal-version: >= 1.2
-build-type: Simple
-homepage: $homepage$
-
-executable $project$
- build-depends: base >= 4 && < 5,
- yesod >= 0.0.0 && < 0.1,
- safe-failure >= 0.4.0 && < 0.5,
- data-object-yaml >= 0.2.0.1 && < 0.3
- main-is: $Datatype$.hs
- ghc-options: -Wall
diff --git a/CLI/yesod.hs b/CLI/yesod.hs
deleted file mode 100644
index 3f6606f9..00000000
--- a/CLI/yesod.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-import Data.FileEmbed
-import Text.StringTemplate
-import Data.ByteString.Char8 (ByteString, unpack)
-import System.Directory
-import System.Environment
-import System.IO
-import Data.Char
-
-skel :: [(FilePath, ByteString)]
-skel = $(embedDir "CLI/skel")
-
-yesodInit :: FilePath -> [(String, String)] -> IO ()
-yesodInit topDir a = do
- mapM_ (\x -> createDirectoryIfMissing True $ topDir ++ x)
- ["static", "templates"]
- mapM_ go skel
- where
- go (fp, bs) = do
- let temp = newSTMP $ unpack bs
- writeFile (topDir ++ fp) $ toString $ setManyAttrib a temp
-
-main :: IO ()
-main = do
- args <- getArgs
- case args of
- ["init"] -> yesodInit'
- _ -> usage
-
-usage :: IO ()
-usage = putStrLn "Currently, the only support operation is \"init\"."
-
-prompt :: String -> (String -> Bool) -> IO String
-prompt s t = do
- putStr s
- hFlush stdout
- x <- getLine
- if t x
- then return x
- else do
- putStrLn "That was not valid input."
- prompt s t
-
-yesodInit' :: IO ()
-yesodInit' = do
- putStrLn "Let's get started created a Yesod web application."
- dest <-
- prompt
- "In which directory would you like to put the application? "
- (not . null)
- dt <-
- prompt
- "Give a data type name (first letter capital): "
- (\x -> not (null x) && isUpper (head x))
- pr <- prompt
- "Name of project (cabal file): "
- (not . null)
- au <- prompt
- "Author (cabal file): "
- (not . null)
- em <- prompt
- "Author email (cabal file): "
- (not . null)
- ho <- prompt
- "Homepage (cabal file): "
- (not . null)
- yesodInit (dest ++ "/")
- [ ("Datatype", dt)
- , ("project", pr)
- , ("author", au)
- , ("email", em)
- , ("homepage", ho)
- ]
- renameFile (dest ++ "/webapp.cabal") (dest ++ "/" ++ pr ++ ".cabal")
- renameFile (dest ++ "/App.hs") (dest ++ "/" ++ dt ++ ".hs")
- putStrLn "Your project has been initialized."
diff --git a/Test/Errors.hs b/Test/Errors.hs
deleted file mode 100644
index 7dfbac61..00000000
--- a/Test/Errors.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE EmptyDataDecls #-}
-module Test.Errors (testSuite) where
-
-import Yesod
-import Yesod.Helpers.Auth
-import Test.Framework (testGroup, Test)
-import Test.Framework.Providers.HUnit
-import Test.HUnit hiding (Test)
-
-data Errors
-instance Yesod Errors where
- resources = [$mkResources|
-/denied:
- Get: denied
-/needs-ident:
- Get: needsIdent
-/has-args:
- Get: hasArgs
-|]
-instance YesodApproot Errors where
- approot _ = "IGNORED/"
-instance YesodAuth Errors
-
-denied :: Handler Errors ()
-denied = permissionDenied
-
-needsIdent :: Handler Errors (Html, HtmlObject)
-needsIdent = do
- i <- authIdentifier
- return (cs "", cs i)
-
-hasArgs :: Handler Errors (Html, HtmlObject)
-hasArgs = do
- {- FIXME wait for new request API
- (a, b) <- runRequest $ (,) <$> getParam "firstParam"
- <*> getParam "secondParam"
- -}
- let (a, b) = ("foo", "bar")
- return (cs "", cs [a :: String, b])
-
-caseErrorMessages :: Assertion
-caseErrorMessages = do return ()
-{- FIXME
- app <- toWaiApp Errors
- res <- app $ def { pathInfo = B8.pack "/denied/" }
- assertBool "/denied/" $ "Permission denied" `isInfixOf` show res
- res' <- app $ def { pathInfo = B8.pack "/needs-ident/" }
- assertBool "/needs-ident/" $ "IGNORED/auth/openid/" `isInfixOf` show res'
- -}
- {- FIXME this test is not yet ready
- res3 <- app $ def { pathInfo = "/has-args/" }
- assertBool "/has-args/" $ "secondParam" `isInfixOf` show res3
- -}
-
-testSuite :: Test
-testSuite = testGroup "Test.Errors"
- [ testCase "errorMessages" caseErrorMessages
- ]
diff --git a/Test/QuasiResource.hs b/Test/QuasiResource.hs
deleted file mode 100644
index c07a3644..00000000
--- a/Test/QuasiResource.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE QuasiQuotes #-}
-
-module Test.QuasiResource (testSuite) where
-
-import Yesod
-import Test.Framework (testGroup, Test)
-import Test.Framework.Providers.HUnit
-import Test.HUnit hiding (Test)
-import Data.List
-import Network.Wai (Method (..))
-
-data MyYesod = MyYesod
-
-instance Show (Handler MyYesod ChooseRep) where show _ = "Another handler"
-
-addHead' :: HtmlObject -> (Html, HtmlObject)
-addHead' x = (cs "", x)
-
-addHead :: Monad m => HtmlObject -> m (Html, HtmlObject)
-addHead = return . addHead'
-
-getStatic :: Method -> [String] -> Handler MyYesod (Html, HtmlObject)
-getStatic v p = addHead $ toHtmlObject ["getStatic", show v, show p]
-pageIndex :: Handler MyYesod (Html, HtmlObject)
-pageIndex = addHead $ toHtmlObject ["pageIndex"]
-pageAdd :: Handler MyYesod ChooseRep
-pageAdd = return $ chooseRep $ addHead' $ toHtmlObject ["pageAdd"]
-pageDetail :: String -> Handler MyYesod ChooseRep
-pageDetail s = return $ chooseRep $ addHead' $ toHtmlObject ["pageDetail", s]
-pageDelete :: String -> Handler MyYesod (Html, HtmlObject)
-pageDelete s = addHead $ toHtmlObject ["pageDelete", s]
-pageUpdate :: String -> Handler MyYesod ChooseRep
-pageUpdate s = return $ chooseRep $ addHead' $ toHtmlObject ["pageUpdate", s]
-userInfo :: Integer -> Handler MyYesod (Html, HtmlObject)
-userInfo i = addHead $ toHtmlObject ["userInfo", show i]
-userVariable :: Integer -> String -> Handler MyYesod (Html, HtmlObject)
-userVariable i s = addHead $ toHtmlObject ["userVariable", show i, s]
-userPage :: Integer -> [String] -> Handler MyYesod (Html, HtmlObject)
-userPage i p = addHead $ toHtmlObject ["userPage", show i, show p]
-
-instance Show (Method -> Handler MyYesod ChooseRep) where
- show _ = "verb -> handler"
-instance Show (Resource -> Method -> Handler MyYesod ChooseRep) where
- show _ = "resource -> verb -> handler"
-handler :: Resource -> Method -> Handler MyYesod ChooseRep
-handler = [$mkResources|
-/static/*filepath/: getStatic
-/page/:
- GET: pageIndex
- PUT: pageAdd
-/page/$page/:
- GET: pageDetail
- DELETE: pageDelete
- POST: pageUpdate
-/user/#id/:
- GET: userInfo
-/user/#id/profile/$variable/:
- GET: userVariable
-/user/#id/page/*page/:
- GET: userPage
-|]
-
-ph :: [String] -> Handler MyYesod ChooseRep -> Assertion
-ph ss h = do
- let eh = return . chooseRep . addHead' . toHtmlObject . show
- rr = error "No raw request"
- y = MyYesod
- cts = [TypeHtml]
- res <- runHandler h eh rr y cts
- res' <- myShow res
- mapM_ (helper res') ss
- where
- helper haystack needle =
- assertBool (show ("needle", needle, ss, haystack))
- $ needle `isInfixOf` haystack
-
-myShow :: Response -> IO String
-myShow (Response sc hs ct c) = runContent c >>= \c' -> return $ unlines
- [ show sc
- , unlines $ map show hs
- , show ct
- , show c'
- ]
-
-caseQuasi :: Assertion
-caseQuasi = do
- ph ["200", "foo"] $ handler ["static", "foo", "bar", "baz"] GET
- ph ["404"] $ handler ["foo", "bar", "baz"] GET
- ph ["200", "pageIndex"] $ handler ["page"] GET
- ph ["404"] $ handler ["user"] GET
- ph ["404"] $ handler ["user", "five"] GET
- ph ["200", "userInfo", "5"] $ handler ["user", "5"] GET
- ph ["200", "userVar"] $ handler ["user", "5", "profile", "email"] GET
-
-testSuite :: Test
-testSuite = testGroup "Test.QuasiResource"
- [ testCase "quasi" caseQuasi
- ]
diff --git a/Test/rep.st b/Test/rep.st
deleted file mode 100644
index 127b7fd7..00000000
--- a/Test/rep.st
+++ /dev/null
@@ -1 +0,0 @@
-foo:$o.foo$, bar:$o.bar$
diff --git a/Test/resource-patterns.yaml b/Test/resource-patterns.yaml
deleted file mode 100644
index fb2eda77..00000000
--- a/Test/resource-patterns.yaml
+++ /dev/null
@@ -1,10 +0,0 @@
-/static/*filepath/: getStatic
-/page/:
- GET: pageIndex
- PUT: pageAdd
-/page/$page/:
- GET: pageDetail
- DELETE: pageDelete
- POST: pageUpdate
-/user/#id/:
- GET: userInfo
diff --git a/runtests.hs b/runtests.hs
index 3357961c..94e448e5 100644
--- a/runtests.hs
+++ b/runtests.hs
@@ -1,15 +1,10 @@
import Test.Framework (defaultMain)
--- FIXME import qualified Test.Errors
--- FIXME import qualified Test.QuasiResource
import qualified Web.Mime
import qualified Yesod.Json
main :: IO ()
main = defaultMain
- [
- Web.Mime.testSuite
+ [ Web.Mime.testSuite
, Yesod.Json.testSuite
- -- FIXME , Test.Errors.testSuite
- -- FIXME, Test.QuasiResource.testSuite
]
diff --git a/yesod.cabal b/yesod.cabal
index 6e26a588..27c57553 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -5,19 +5,11 @@ license-file: LICENSE
author: Michael Snoyman
maintainer: Michael Snoyman
synopsis: A library for creating RESTful web applications.
-description: This package stradles the line between framework and simply a controller. It provides minimal support for model and view, mostly focusing on making a controller which adheres strictly to RESTful principles.
category: Web
-stability: unstable
+stability: Stable
cabal-version: >= 1.6
build-type: Simple
-homepage: http://www.yesodweb.com/code.html
-extra-source-files: CLI/skel/App.hs,
- CLI/skel/static/style.css,
- CLI/skel/settings.yaml,
- CLI/skel/LICENSE,
- CLI/skel/webapp.cabal,
- CLI/skel/templates/layout.st,
- CLI/skel/templates/homepage.st
+homepage: http://docs.yesodweb.com/yesod/
flag transformers_02
description: transformers = 0.2.*
@@ -65,12 +57,6 @@ library
Web.Mime
ghc-options: -Wall
-executable yesod
- ghc-options: -Wall
- build-depends: file-embed >= 0.0.3 && < 0.1,
- HStringTemplate >= 0.6.2 && < 0.7
- main-is: CLI/yesod.hs
-
executable runtests
if flag(buildtests)
Buildable: True