Fully remove the yesod init command (fixes #1132)
This commit is contained in:
Michael Snoyman
parent
5dff4adf86
commit
3228b40843
@ -1,3 +1,7 @@
|
||||
## 1.4.17
|
||||
|
||||
* Fully remove the `yesod init` command
|
||||
|
||||
## 1.4.16.1
|
||||
|
||||
* Workaround for [wai#478](https://github.com/yesodweb/wai/issues/478)
|
||||
|
||||
@ -1,153 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Scaffolding.Scaffolder (scaffold, backendOptions) where
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import qualified Data.ByteString.Char8 as S
|
||||
import Data.Conduit (yield, ($$), ($$+-))
|
||||
import Control.Monad.Trans.Resource (runResourceT)
|
||||
import Control.DeepSeq (($!!), NFData)
|
||||
import Data.FileEmbed (embedFile)
|
||||
import GHC.Generics (Generic)
|
||||
import Data.String (fromString)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Data.Text.Lazy.IO as TLIO
|
||||
import Text.ProjectTemplate (unpackTemplate, receiveFS)
|
||||
import System.IO
|
||||
import Text.Shakespeare.Text (renderTextUrl, textFile)
|
||||
import Network.HTTP.Conduit (Request, withManager, http, parseUrl, responseBody)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.List (intercalate)
|
||||
import Distribution.Text (simpleParse)
|
||||
import Distribution.Package (PackageName)
|
||||
|
||||
prompt :: (String -> Maybe a) -> IO a
|
||||
prompt f = do
|
||||
s <- getLine
|
||||
case f s of
|
||||
Just a -> return a
|
||||
Nothing -> do
|
||||
putStr "That was not a valid entry, please try again: "
|
||||
hFlush stdout
|
||||
prompt f
|
||||
|
||||
data BackendInput = BIUrl
|
||||
| BIBackend Backend
|
||||
| BIUndefined
|
||||
deriving (Generic)
|
||||
|
||||
instance NFData BackendInput
|
||||
|
||||
data Backend = Sqlite
|
||||
| Postgresql
|
||||
| PostgresqlFay
|
||||
| Mysql
|
||||
| MongoDB
|
||||
| Simple
|
||||
| Minimal
|
||||
deriving (Eq, Read, Show, Enum, Bounded, Generic)
|
||||
|
||||
instance NFData Backend
|
||||
|
||||
puts :: LT.Text -> IO ()
|
||||
puts s = TLIO.putStr (LT.init s) >> hFlush stdout
|
||||
|
||||
backends :: [Backend]
|
||||
backends = [minBound .. maxBound]
|
||||
|
||||
backendOptions :: String
|
||||
backendOptions = intercalate "/" (map inputBackend backends)
|
||||
|
||||
showBackend :: Backend -> String
|
||||
showBackend Sqlite = "s"
|
||||
showBackend Postgresql = "p"
|
||||
showBackend PostgresqlFay = "pf"
|
||||
showBackend Mysql = "mysql"
|
||||
showBackend MongoDB = "mongo"
|
||||
showBackend Simple = "simple"
|
||||
showBackend Minimal = "mini"
|
||||
|
||||
inputBackend :: Backend -> String
|
||||
inputBackend Sqlite = "sqlite"
|
||||
inputBackend Postgresql = "postgresql"
|
||||
inputBackend PostgresqlFay = "postgresql_fay"
|
||||
inputBackend Mysql = "mysql"
|
||||
inputBackend MongoDB = "mongo"
|
||||
inputBackend Simple = "simple"
|
||||
inputBackend Minimal = "mini"
|
||||
|
||||
readBackend :: (Backend -> String) -> String -> Maybe Backend
|
||||
readBackend f s = lookup s $ map (f &&& id) backends
|
||||
|
||||
backendBS :: Backend -> S.ByteString
|
||||
backendBS Sqlite = $(embedFile "hsfiles/sqlite.hsfiles")
|
||||
backendBS Postgresql = $(embedFile "hsfiles/postgres.hsfiles")
|
||||
backendBS PostgresqlFay = $(embedFile "hsfiles/postgres-fay.hsfiles")
|
||||
backendBS Mysql = $(embedFile "hsfiles/mysql.hsfiles")
|
||||
backendBS MongoDB = $(embedFile "hsfiles/mongo.hsfiles")
|
||||
backendBS Simple = $(embedFile "hsfiles/simple.hsfiles")
|
||||
backendBS Minimal = $(embedFile "hsfiles/minimal.hsfiles")
|
||||
|
||||
validPackageName :: String -> Bool
|
||||
validPackageName s = isJust (simpleParse s :: Maybe PackageName) && s /= "test"
|
||||
|
||||
scaffold :: Bool -- ^ bare directory instead of a new subdirectory?
|
||||
-> Maybe String -- ^ application name
|
||||
-> Maybe String -- ^ database
|
||||
-> IO ()
|
||||
scaffold isBare appName appDatabase = (requestMissing $!! validatedInput) >>= unpack
|
||||
where
|
||||
validatedInput :: (Maybe String, BackendInput)
|
||||
validatedInput = (name, db)
|
||||
where
|
||||
name = fmap (\ s -> if validPackageName s then s else error "Invalid value for --name option.") appName
|
||||
db = maybe BIUndefined validateDB appDatabase
|
||||
where
|
||||
validateDB "url" = BIUrl
|
||||
validateDB s = maybe (error "Invalid value for --database option.") BIBackend (readBackend inputBackend s)
|
||||
|
||||
requestMissing :: (Maybe String, BackendInput) -> IO (String, Either Request Backend)
|
||||
requestMissing (name, database) = do
|
||||
puts $ renderTextUrl undefined $(textFile "input/welcome.cg")
|
||||
project <- maybe promptName return name
|
||||
ebackend <- backend database
|
||||
return (project, ebackend)
|
||||
where
|
||||
promptName = do
|
||||
puts $ renderTextUrl undefined $(textFile "input/project_name.cg")
|
||||
prompt $ \s -> if validPackageName s then Just s else Nothing
|
||||
|
||||
backend :: BackendInput -> IO (Either Request Backend)
|
||||
backend (BIBackend back) = return $ Right back
|
||||
backend BIUndefined = do
|
||||
puts $ renderTextUrl undefined $(textFile "input/database.cg")
|
||||
ebackend' <- prompt $ \s -> if s == "url" then Just (Left ()) else fmap Right $ readBackend showBackend s
|
||||
case ebackend' of
|
||||
Left () -> requestUrl
|
||||
Right back -> return $ Right back
|
||||
backend BIUrl = requestUrl
|
||||
|
||||
requestUrl = do
|
||||
puts "Please enter the URL: "
|
||||
fmap Left $ prompt parseUrl
|
||||
|
||||
unpack :: (String, Either Request Backend) -> IO ()
|
||||
unpack (project, ebackend) = do
|
||||
putStrLn "That's it! I'm creating your files now..."
|
||||
case ebackend of
|
||||
Left req -> withManager $ \m -> do
|
||||
res <- http req m
|
||||
responseBody res $$+- sink
|
||||
Right backend -> runResourceT $ yield (backendBS backend) $$ sink
|
||||
TLIO.putStr $ projectnameReplacer $ renderTextUrl undefined $(textFile "input/done.cg")
|
||||
where
|
||||
sink = unpackTemplate
|
||||
(receiveFS $ if isBare then "." else fromString project)
|
||||
( T.replace "PROJECTNAME" (T.pack project)
|
||||
. T.replace "PROJECTNAME_LOWER" (T.toLower $ T.pack project)
|
||||
)
|
||||
projectnameReplacer = if isBare
|
||||
then LT.replace "cd PROJECTNAME && " ""
|
||||
else LT.replace "PROJECTNAME" (LT.pack project)
|
||||
@ -1 +0,0 @@
|
||||
This directory contains autogenerated files. If you wish to make a modification to the scaffolded site, please [visit the yesod-scaffold project](https://github.com/yesodweb/yesod-scaffold#readme) for more information. Pull requests against the .hsfiles will not be accepted.
|
||||
@ -1,144 +0,0 @@
|
||||
{-# START_FILE .dir-locals.el #-}
|
||||
((haskell-mode . ((haskell-indent-spaces . 4)
|
||||
(haskell-process-use-ghci . t)))
|
||||
(hamlet-mode . ((hamlet/basic-offset . 4)
|
||||
(haskell-process-use-ghci . t))))
|
||||
|
||||
{-# START_FILE .ghci #-}
|
||||
:set -i.:config:dist/build/autogen
|
||||
:set -DDEVELOPMENT
|
||||
: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*
|
||||
static/tmp/
|
||||
static/combined/
|
||||
config/client_session_key.aes
|
||||
*.hi
|
||||
*.o
|
||||
*.sqlite3
|
||||
*.sqlite3-shm
|
||||
*.sqlite3-wal
|
||||
.hsenv*
|
||||
cabal-dev/
|
||||
.stack-work/
|
||||
yesod-devel/
|
||||
.cabal-sandbox
|
||||
cabal.sandbox.config
|
||||
.DS_Store
|
||||
*.swp
|
||||
*.keter
|
||||
|
||||
{-# START_FILE Add.hs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Add where
|
||||
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
|
||||
getAddR :: Int -> Int -> Handler TypedContent
|
||||
getAddR x y = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Addition"
|
||||
[whamlet|#{x} + #{y} = #{z}|]
|
||||
provideJson $ object ["result" .= z]
|
||||
where
|
||||
z = x + y
|
||||
|
||||
{-# START_FILE Application.hs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Application where
|
||||
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
|
||||
import Add
|
||||
import Home
|
||||
|
||||
mkYesodDispatch "App" resourcesApp
|
||||
|
||||
{-# START_FILE Foundation.hs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Foundation where
|
||||
|
||||
import Yesod.Core
|
||||
|
||||
data App = App
|
||||
|
||||
mkYesodData "App" $(parseRoutesFile "routes")
|
||||
|
||||
instance Yesod App
|
||||
|
||||
{-# START_FILE Home.hs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Home where
|
||||
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
|
||||
getHomeR :: Handler Html
|
||||
getHomeR = defaultLayout $ do
|
||||
setTitle "Minimal Multifile"
|
||||
[whamlet|
|
||||
<p>
|
||||
<a href=@{AddR 5 7}>HTML addition
|
||||
<p>
|
||||
<a href=@{AddR 5 7}?_accept=application/json>JSON addition
|
||||
|]
|
||||
|
||||
{-# START_FILE Main.hs #-}
|
||||
import Application () -- for YesodDispatch instance
|
||||
import Foundation
|
||||
import Yesod.Core
|
||||
|
||||
main :: IO ()
|
||||
main = warp 3000 App
|
||||
|
||||
{-# START_FILE PROJECTNAME.cabal #-}
|
||||
name: PROJECTNAME
|
||||
version: 0.0.0
|
||||
cabal-version: >= 1.8
|
||||
build-type: Simple
|
||||
extra-source-files: routes
|
||||
|
||||
executable PROJECTNAME
|
||||
main-is: Main.hs
|
||||
other-modules: Application
|
||||
Foundation
|
||||
|
||||
Add
|
||||
Home
|
||||
|
||||
ghc-options: -Wall -fwarn-tabs -O2
|
||||
|
||||
build-depends: base
|
||||
, yesod-core
|
||||
|
||||
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
|
||||
|
||||
{-# START_FILE routes #-}
|
||||
/ HomeR GET
|
||||
/add/#Int/#Int AddR GET
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,15 +0,0 @@
|
||||
Yesod uses Persistent for its (you guessed it) persistence layer.
|
||||
This tool will build in either SQLite or PostgreSQL or MongoDB support for you.
|
||||
We recommend starting with SQLite: it has no dependencies.
|
||||
|
||||
s = sqlite
|
||||
p = postgresql
|
||||
pf = postgresql + Fay (experimental)
|
||||
mongo = mongodb
|
||||
mysql = MySQL
|
||||
simple = no database, no auth
|
||||
mini = bare bones, the "Hello World" of multi-file Yesod apps
|
||||
(Note: not configured to work with yesod devel)
|
||||
url = Let me specify URL containing a site (advanced)
|
||||
|
||||
So, what'll it be?
|
||||
@ -1,30 +0,0 @@
|
||||
|
||||
---------------------------------------
|
||||
|
||||
___
|
||||
{-) |\
|
||||
[m,].-"-. /
|
||||
[][__][__] \(/\__/\)/
|
||||
[__][__][__][__]~~~~ | |
|
||||
[][__][__][__][__][] / |
|
||||
[__][__][__][__][__]| /| |
|
||||
[][__][__][__][__][]| || | ~~~~
|
||||
ejm [__][__][__][__][__]__,__, \__/
|
||||
|
||||
|
||||
---------------------------------------
|
||||
|
||||
The foundation for your web application has been built.
|
||||
|
||||
|
||||
There are a lot of resources to help you use Yesod.
|
||||
Start with the book: http://www.yesodweb.com/book
|
||||
Take part in the community: http://yesodweb.com/page/community
|
||||
|
||||
|
||||
It's highly recommended to follow the quick start guide for
|
||||
installing Yesod: http://www.yesodweb.com/page/quickstart
|
||||
|
||||
If your system is already configured correctly, please run:
|
||||
|
||||
cd PROJECTNAME && stack build && stack exec -- yesod devel
|
||||
@ -1,4 +0,0 @@
|
||||
|
||||
What do you want to call your project? We'll use this for the cabal name.
|
||||
|
||||
Project name:
|
||||
@ -1,3 +0,0 @@
|
||||
Welcome to the Yesod scaffolder.
|
||||
I'm going to be creating a skeleton Yesod project for you.
|
||||
|
||||
@ -15,7 +15,6 @@ import Devel (DevelOpts (..), devel, DevelTermOpt(..)
|
||||
import Keter (keter)
|
||||
import Options (injectDefaults)
|
||||
import qualified Paths_yesod_bin
|
||||
import Scaffolding.Scaffolder (scaffold, backendOptions)
|
||||
|
||||
import HsFile (mkHsFile)
|
||||
#ifndef WINDOWS
|
||||
@ -43,7 +42,7 @@ data Options = Options
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Command = Init { _initBare :: Bool, _initName :: Maybe String, _initDatabase :: Maybe String }
|
||||
data Command = Init [String]
|
||||
| HsFiles
|
||||
| Configure
|
||||
| Build { buildExtraArgs :: [String] }
|
||||
@ -102,9 +101,7 @@ main = do
|
||||
] optParser'
|
||||
let cabal = rawSystem' (cabalCommand o)
|
||||
case optCommand o of
|
||||
Init{..} -> do
|
||||
putStrLn "NOTE: This command has been deprecated in favor of 'stack new'"
|
||||
scaffold _initBare _initName _initDatabase
|
||||
Init _ -> error "The init command has been removed. Please use 'stack new' instead"
|
||||
HsFiles -> mkHsFile
|
||||
Configure -> cabal ["configure"]
|
||||
Build es -> touch' >> cabal ("build":es)
|
||||
@ -158,7 +155,7 @@ 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 initOptions
|
||||
(progDesc "Scaffold a new site"))
|
||||
(progDesc "Command no longer available, please use 'stack new'"))
|
||||
<> command "hsfiles" (info (pure HsFiles)
|
||||
(progDesc "Create a hsfiles file for the current folder"))
|
||||
<> command "configure" (info (pure Configure)
|
||||
@ -181,12 +178,7 @@ optParser = Options
|
||||
)
|
||||
|
||||
initOptions :: Parser Command
|
||||
initOptions = Init
|
||||
<$> switch (long "bare" <> help "Create files in current folder")
|
||||
<*> optStr (long "name" <> short 'n' <> metavar "APP_NAME"
|
||||
<> help "Set the application name")
|
||||
<*> optStr (long "database" <> short 'd' <> metavar "DATABASE"
|
||||
<> help ("Preconfigure for selected database (options: " ++ backendOptions ++ ")"))
|
||||
initOptions = Init <$> many (argument str mempty)
|
||||
|
||||
keterOptions :: Parser Command
|
||||
keterOptions = Keter
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-bin
|
||||
version: 1.4.16.1
|
||||
version: 1.4.17
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
@ -14,8 +14,6 @@ homepage: http://www.yesodweb.com/
|
||||
data-files: refreshing.html
|
||||
|
||||
extra-source-files:
|
||||
input/*.cg
|
||||
hsfiles/*.hsfiles
|
||||
ChangeLog.md
|
||||
*.pem
|
||||
|
||||
@ -92,8 +90,7 @@ executable yesod
|
||||
|
||||
ghc-options: -Wall -threaded -rtsopts
|
||||
main-is: main.hs
|
||||
other-modules: Scaffolding.Scaffolder
|
||||
Devel
|
||||
other-modules: Devel
|
||||
Build
|
||||
GhcBuild
|
||||
Keter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user