yesod-bin 1.4.5 → 1.4.5.1
raw patch · 10 files changed
+381/−106 lines, 10 files
Files
- AddHandler.hs +75/−30
- hsfiles/minimal.hsfiles +16/−1
- hsfiles/mongo.hsfiles +41/−10
- hsfiles/mysql.hsfiles +41/−10
- hsfiles/postgres-fay.hsfiles +55/−18
- hsfiles/postgres.hsfiles +55/−18
- hsfiles/simple.hsfiles +36/−5
- hsfiles/sqlite.hsfiles +43/−10
- main.hs +18/−3
- yesod-bin.cabal +1/−1
AddHandler.hs view
@@ -2,61 +2,106 @@ module AddHandler (addHandler) where import Prelude hiding (readFile)-import System.IO (hFlush, stdout)-import Data.Char (isLower, toLower, isSpace)-import Data.List (isPrefixOf, isSuffixOf, stripPrefix)+import System.IO (hFlush, stdout)+import Data.Char (isLower, toLower, isSpace)+import Data.List (isPrefixOf, isSuffixOf, stripPrefix)+import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.IO as TIO import System.Directory (getDirectoryContents, doesFileExist) +data RouteError = EmptyRoute+ | RouteCaseError+ | RouteExists FilePath+ deriving Eq++instance Show RouteError where+ show EmptyRoute = "No name entered. Quitting ..."+ show RouteCaseError = "Name must start with an upper case letter"+ show (RouteExists file) = "File already exists: " ++ file+ -- strict readFile readFile :: FilePath -> IO String readFile = fmap T.unpack . TIO.readFile -addHandler :: IO ()-addHandler = do- allFiles <- getDirectoryContents "."- cabal <-- case filter (".cabal" `isSuffixOf`) allFiles of- [x] -> return x- [] -> error "No cabal file found"- _ -> error "Too many cabal files found"+cmdLineArgsError :: String+cmdLineArgsError = "You have to specify a route name if you want to add handler with command line arguments." +addHandler :: Maybe String -> Maybe String -> [String] -> IO ()+addHandler (Just route) pat met = do+ cabal <- getCabal+ checked <- checkRoute route+ let routePair = case checked of+ Left err@EmptyRoute -> (error . show) err+ Left err@RouteCaseError -> (error . show) err+ Left err@(RouteExists _) -> (error . show) err+ Right p -> p++ addHandlerFiles cabal routePair pattern methods+ where+ pattern = fromMaybe "" pat -- pattern defaults to ""+ methods = unwords met -- methods default to none++addHandler Nothing (Just _) _ = error cmdLineArgsError+addHandler Nothing _ (_:_) = error cmdLineArgsError+addHandler _ _ _ = addHandlerInteractive++addHandlerInteractive :: IO ()+addHandlerInteractive = do+ cabal <- getCabal let routeInput = do putStr "Name of route (without trailing R): " hFlush stdout name <- getLine- case name of- [] -> error "No name entered. Quitting ..."- c:_- | isLower c -> do- putStrLn "Name must start with an upper case letter"- routeInput- | otherwise -> do- -- Check that the handler file doesn't already exist- let handlerFile = concat ["Handler/", name, ".hs"]- exists <- doesFileExist handlerFile- if exists- then do- putStrLn $ "File already exists: " ++ show handlerFile- putStrLn "Try another name or leave blank to exit"- routeInput- else return (name, handlerFile)+ checked <- checkRoute name+ case checked of+ Left err@EmptyRoute -> (error . show) err+ Left err@RouteCaseError -> print err >> routeInput+ Left err@(RouteExists _) -> do+ print err+ putStrLn "Try another name or leave blank to exit"+ routeInput+ Right p -> return p - (name, handlerFile) <- routeInput+ routePair <- routeInput putStr "Enter route pattern (ex: /entry/#EntryId): " hFlush stdout pattern <- getLine putStr "Enter space-separated list of methods (ex: GET POST): " hFlush stdout methods <- getLine-- let modify fp f = readFile fp >>= writeFile fp . f+ addHandlerFiles cabal routePair pattern methods +addHandlerFiles :: FilePath -> (String, FilePath) -> String -> String -> IO ()+addHandlerFiles cabal (name, handlerFile) pattern methods = do modify "Application.hs" $ fixApp name modify cabal $ fixCabal name modify "config/routes" $ fixRoutes name pattern methods writeFile handlerFile $ mkHandler name pattern methods+ where+ modify fp f = readFile fp >>= writeFile fp . f++getCabal :: IO FilePath+getCabal = do+ allFiles <- getDirectoryContents "."+ case filter (".cabal" `isSuffixOf`) allFiles of+ [x] -> return x+ [] -> error "No cabal file found"+ _ -> error "Too many cabal files found"++checkRoute :: String -> IO (Either RouteError (String, FilePath))+checkRoute name =+ case name of+ [] -> return $ Left EmptyRoute+ c:_+ | isLower c -> return $ Left RouteCaseError+ | otherwise -> do+ -- Check that the handler file doesn't already exist+ let handlerFile = concat ["Handler/", name, ".hs"]+ exists <- doesFileExist handlerFile+ if exists+ then (return . Left . RouteExists) handlerFile+ else return $ Right (name, handlerFile) fixApp :: String -> String -> String fixApp name =
hsfiles/minimal.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*
hsfiles/mongo.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -231,7 +246,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -312,11 +327,10 @@ x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Just uid- Nothing -> do- fmap Just $ insert User- { userIdent = credsIdent creds- , userPassword = Nothing- }+ Nothing -> Just <$> insert User+ { userIdent = credsIdent creds+ , userPassword = Nothing+ } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def]@@ -504,7 +518,7 @@ , template-haskell , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -514,7 +528,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -564,6 +578,7 @@ , persistent-mongoDB , resourcet , monad-logger+ , shakespeare , transformers , hspec >= 2.0.0 , classy-prelude@@ -8997,6 +9012,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -9008,6 +9024,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -9018,10 +9035,24 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990+}+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px } {-# START_FILE test/Handler/CommonSpec.hs #-}
hsfiles/mysql.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -246,7 +261,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -326,11 +341,10 @@ x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Just uid- Nothing -> do- fmap Just $ insert User- { userIdent = credsIdent creds- , userPassword = Nothing- }+ Nothing -> Just <$> insert User+ { userIdent = credsIdent creds+ , userPassword = Nothing+ } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def]@@ -515,7 +529,7 @@ , template-haskell , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -525,7 +539,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -575,6 +589,7 @@ , persistent-mysql , resourcet , monad-logger+ , shakespeare , transformers , hspec >= 2.0.0 , classy-prelude@@ -9007,6 +9022,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -9018,6 +9034,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -9028,10 +9045,24 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990+}+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px } {-# START_FILE test/Handler/CommonSpec.hs #-}
hsfiles/postgres-fay.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -253,7 +268,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -342,11 +357,10 @@ x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Just uid- Nothing -> do- fmap Just $ insert User- { userIdent = credsIdent creds- , userPassword = Nothing- }+ Nothing -> Just <$> insert User+ { userIdent = credsIdent creds+ , userPassword = Nothing+ } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def]@@ -559,7 +573,7 @@ , persistent-template >= 2.0 && < 2.2 , template-haskell , shakespeare >= 2.0 && < 2.1- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -569,7 +583,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -619,6 +633,7 @@ , persistent-postgresql , resourcet , monad-logger+ , shakespeare , transformers , hspec >= 2.0.0 , classy-prelude@@ -9122,6 +9137,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -9133,6 +9149,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -9148,11 +9165,25 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990 }+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px+} {-# START_FILE test/Handler/CommonSpec.hs #-} module Handler.CommonSpec (spec) where@@ -9223,6 +9254,7 @@ import Foundation as X import Model as X import Test.Hspec as X+import Text.Shakespeare.Text (st) import Yesod.Default.Config2 (ignoreEnv, loadAppSettings) import Yesod.Test as X @@ -9249,16 +9281,21 @@ -- 'withApp' calls it before each test, creating a clean environment for each -- spec to run in. wipeDB :: App -> IO ()-wipeDB app = do- runDBWithApp app $ do- tables <- getTables- sqlBackend <- ask+wipeDB app = runDBWithApp app $ do+ tables <- getTables+ sqlBackend <- ask - let escapedTables = map (connEscapeName sqlBackend . DBName) tables- query = "TRUNCATE TABLE " ++ (intercalate ", " escapedTables)- rawExecute query []+ let escapedTables = map (connEscapeName sqlBackend . DBName) tables+ query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables+ rawExecute query [] getTables :: MonadIO m => ReaderT SqlBackend m [Text] getTables = do- tables <- rawSql "SELECT table_name FROM information_schema.tables WHERE table_schema = 'public';" []+ tables <- rawSql [st|+ SELECT table_name+ FROM information_schema.tables+ WHERE table_schema = 'public';+ |] []+ return $ map unSingle tables+
hsfiles/postgres.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -246,7 +261,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -326,11 +341,10 @@ x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Just uid- Nothing -> do- fmap Just $ insert User- { userIdent = credsIdent creds- , userPassword = Nothing- }+ Nothing -> Just <$> insert User+ { userIdent = credsIdent creds+ , userPassword = Nothing+ } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def]@@ -515,7 +529,7 @@ , template-haskell , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -525,7 +539,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -575,6 +589,7 @@ , persistent-postgresql , resourcet , monad-logger+ , shakespeare , transformers , hspec >= 2.0.0 , classy-prelude@@ -9007,6 +9022,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -9018,6 +9034,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -9028,11 +9045,25 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990 }+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px+} {-# START_FILE test/Handler/CommonSpec.hs #-} module Handler.CommonSpec (spec) where@@ -9103,6 +9134,7 @@ import Foundation as X import Model as X import Test.Hspec as X+import Text.Shakespeare.Text (st) import Yesod.Default.Config2 (ignoreEnv, loadAppSettings) import Yesod.Test as X @@ -9129,16 +9161,21 @@ -- 'withApp' calls it before each test, creating a clean environment for each -- spec to run in. wipeDB :: App -> IO ()-wipeDB app = do- runDBWithApp app $ do- tables <- getTables- sqlBackend <- ask+wipeDB app = runDBWithApp app $ do+ tables <- getTables+ sqlBackend <- ask - let escapedTables = map (connEscapeName sqlBackend . DBName) tables- query = "TRUNCATE TABLE " ++ (intercalate ", " escapedTables)- rawExecute query []+ let escapedTables = map (connEscapeName sqlBackend . DBName) tables+ query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables+ rawExecute query [] getTables :: MonadIO m => ReaderT SqlBackend m [Text] getTables = do- tables <- rawSql "SELECT table_name FROM information_schema.tables WHERE table_schema = 'public';" []+ tables <- rawSql [st|+ SELECT table_name+ FROM information_schema.tables+ WHERE table_schema = 'public';+ |] []+ return $ map unSingle tables+
hsfiles/simple.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -219,7 +234,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -428,7 +443,7 @@ , template-haskell , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -438,7 +453,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -8888,6 +8903,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -8899,6 +8915,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -8909,10 +8926,24 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990+}+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px } {-# START_FILE test/Handler/CommonSpec.hs #-}
hsfiles/sqlite.hsfiles view
@@ -7,7 +7,22 @@ {-# START_FILE .ghci #-} :set -i.:config:dist/build/autogen :set -DDEVELOPMENT-:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable+:set -XCPP+:set -XDeriveDataTypeable+:set -XEmptyDataDecls+:set -XFlexibleContexts+:set -XGADTs+:set -XGeneralizedNewtypeDeriving+:set -XMultiParamTypeClasses+:set -XNoImplicitPrelude+:set -XNoMonomorphismRestriction+:set -XOverloadedStrings+:set -XQuasiQuotes+:set -XRecordWildCards+:set -XTemplateHaskell+:set -XTupleSections+:set -XTypeFamilies+:set -XViewPatterns {-# START_FILE .gitignore #-} dist*@@ -246,7 +261,7 @@ -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend+ makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "config/client_session_key.aes" @@ -326,11 +341,10 @@ x <- getBy $ UniqueUser $ credsIdent creds case x of Just (Entity uid _) -> return $ Just uid- Nothing -> do- fmap Just $ insert User- { userIdent = credsIdent creds- , userPassword = Nothing- }+ Nothing -> Just <$> insert User+ { userIdent = credsIdent creds+ , userPassword = Nothing+ } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def]@@ -515,7 +529,7 @@ , template-haskell , shakespeare >= 2.0 && < 2.1 , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4+ , monad-control >= 0.3 && < 1.1 , wai-extra >= 3.0 && < 3.1 , yaml >= 0.8 && < 0.9 , http-conduit >= 2.1 && < 2.2@@ -525,7 +539,7 @@ , aeson >= 0.6 && < 0.9 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4- , fast-logger >= 2.2 && < 2.3+ , fast-logger >= 2.2 && < 2.4 , wai-logger >= 2.2 && < 2.3 , file-embed , safe@@ -575,6 +589,7 @@ , persistent-sqlite , resourcet , monad-logger+ , shakespeare , transformers , hspec >= 2.0.0 , classy-prelude@@ -9025,6 +9040,7 @@ <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. + <hr /> <li #form> This is an example trivial Form. Read the # \<a href="http://www.yesodweb.com/book/forms">Forms chapter<span class="glyphicon glyphicon-bookmark"></span></a> #@@ -9036,6 +9052,7 @@ ^{formWidget} <button .btn .btn-primary type="submit"> Send it! <span class="glyphicon glyphicon-upload"></span>+ <hr /> <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # test suite that performs tests on this page. #@@ -9046,11 +9063,25 @@ {-# START_FILE templates/homepage.lucius #-} h1 {- text-align: center+ text-align: center;+ margin-bottom: 30px } h2##{aDomId} { color: #990 }+li {+ line-height: 2em;+ font-size: 16px+}+ol {+ margin-bottom: 30px+}+footer {+ text-align: center+}+.input-sm {+ margin-left: 20px+} {-# START_FILE test/Handler/CommonSpec.hs #-} module Handler.CommonSpec (spec) where@@ -9121,6 +9152,7 @@ import Foundation as X import Model as X import Test.Hspec as X+import Text.Shakespeare.Text (st) import Yesod.Default.Config2 (ignoreEnv, loadAppSettings) import Yesod.Test as X @@ -9182,3 +9214,4 @@ getTables = do tables <- rawSql "SELECT name FROM sqlite_master WHERE type = 'table';" [] return (fmap unSingle tables)+
main.hs view
@@ -60,6 +60,10 @@ } | Test | AddHandler+ { addHandlerRoute :: Maybe String+ , addHandlerPattern :: Maybe String+ , addHandlerMethods :: [String]+ } | Keter { _keterNoRebuild :: Bool , _keterNoCopyTo :: Bool@@ -101,7 +105,7 @@ Touch -> touch' Keter{..} -> keter (cabalCommand o) _keterNoRebuild _keterNoCopyTo Version -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)- AddHandler -> addHandler+ AddHandler{..} -> addHandler addHandlerRoute addHandlerPattern addHandlerMethods Test -> cabalTest cabal Devel{..} -> devel (DevelOpts (optCabalPgm o == CabalDev) _develDisableApi (optVerbose o)@@ -138,8 +142,9 @@ (progDesc "Run project with the devel server")) <> command "test" (info (pure Test) (progDesc "Build and run the integration tests"))- <> command "add-handler" (info (pure AddHandler)- (progDesc "Add a new handler and module to the project"))+ <> command "add-handler" (info addHandlerOptions+ (progDesc ("Add a new handler and module to the project."+ ++ " Interactively asks for input if you do not specify arguments."))) <> command "keter" (info keterOptions (progDesc "Build a keter bundle")) <> command "version" (info (pure Version)@@ -184,6 +189,16 @@ extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG" <> help "pass extra argument ARG to cabal") )++addHandlerOptions :: Parser Command+addHandlerOptions = AddHandler+ <$> optStr ( long "route" <> short 'r' <> metavar "ROUTE"+ <> help "Name of route (without trailing R). Required.")+ <*> optStr ( long "pattern" <> short 'p' <> metavar "PATTERN"+ <> help "Route pattern (ex: /entry/#EntryId). Defaults to \"\".")+ <*> many (strOption ( long "method" <> short 'm' <> metavar "METHOD"+ <> help "Takes one method. Use this multiple times to add multiple methods. Defaults to none.")+ ) -- | Optional @String@ argument optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String)
yesod-bin.cabal view
@@ -1,5 +1,5 @@ name: yesod-bin-version: 1.4.5+version: 1.4.5.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>