Use Cabal's Distribution.Text/Distribution.Package to validate package names
This commit is contained in:
parent
5b5caf2ad4
commit
7315a464d7
@ -15,8 +15,9 @@ import Text.ProjectTemplate (unpackTemplate, receiveFS)
|
||||
import System.IO
|
||||
import Text.Shakespeare.Text (renderTextUrl, textFile)
|
||||
import Network.HTTP.Conduit (withManager, http, parseUrl, responseBody)
|
||||
import Data.List.Split (splitOn)
|
||||
import Data.Char (isDigit)
|
||||
import Data.Maybe (isJust)
|
||||
import Distribution.Text (simpleParse)
|
||||
import Distribution.Package (PackageName)
|
||||
|
||||
prompt :: (String -> Maybe a) -> IO a
|
||||
prompt f = do
|
||||
@ -61,27 +62,15 @@ backendBS Mysql = $(embedFile "hsfiles/mysql.hsfiles")
|
||||
backendBS MongoDB = $(embedFile "hsfiles/mongo.hsfiles")
|
||||
backendBS Simple = $(embedFile "hsfiles/simple.hsfiles")
|
||||
|
||||
-- | Is the character valid for a project name?
|
||||
validPN :: Char -> Bool
|
||||
validPN c
|
||||
| 'A' <= c && c <= 'Z' = True
|
||||
| 'a' <= c && c <= 'z' = True
|
||||
| '0' <= c && c <= '9' = True
|
||||
validPN '-' = True
|
||||
validPN _ = False
|
||||
|
||||
-- | Cabal separates packages with a hyphen into words. A word can't consist of only digits
|
||||
-- <http://www.haskell.org/ghc/docs/7.0.3/html/Cabal/packages.html Relevant Cabal Docs>
|
||||
-- Fixes <https://github.com/yesodweb/yesod/issues/550 #550>
|
||||
wordsHaveOneCharacter :: String -> Bool
|
||||
wordsHaveOneCharacter s = not $ any (all isDigit) (splitOn "-" s)
|
||||
validPackageName :: String -> Bool
|
||||
validPackageName s = isJust (simpleParse s :: Maybe PackageName)
|
||||
|
||||
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" && wordsHaveOneCharacter s
|
||||
if validPackageName s && s /= "test"
|
||||
then Just s
|
||||
else Nothing
|
||||
let dir = project
|
||||
|
||||
Loading…
Reference in New Issue
Block a user