add a random error message and verify project dir doesn't already exists
This commit is contained in:
parent
6e60e55787
commit
93efa73991
2 changed files with 33 additions and 10 deletions
|
@ -41,6 +41,7 @@ executable holy-project
|
||||||
, time
|
, time
|
||||||
, filepath
|
, filepath
|
||||||
, process
|
, process
|
||||||
|
, random
|
||||||
-- from Tasty cabal with ansi-terminal
|
-- from Tasty cabal with ansi-terminal
|
||||||
cpp-options: -DCOLORS
|
cpp-options: -DCOLORS
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
|
@ -72,6 +73,7 @@ executable test-holy-project
|
||||||
, tasty-hunit
|
, tasty-hunit
|
||||||
, tasty-quickcheck
|
, tasty-quickcheck
|
||||||
, tasty-smallcheck
|
, tasty-smallcheck
|
||||||
|
|
||||||
test-suite Tests
|
test-suite Tests
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
41
src/Main.hs
41
src/Main.hs
|
@ -10,7 +10,7 @@ import Data.Time.Clock
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
-- Console read write with colors
|
-- Console read write with colors
|
||||||
import System.Console.ANSI
|
import System.Console.ANSI
|
||||||
import System.IO (hFlush, stdout)
|
import System.IO (hFlush, stdout,hPutStrLn, stderr)
|
||||||
-- Hastache
|
-- Hastache
|
||||||
import Data.Data
|
import Data.Data
|
||||||
import Text.Hastache
|
import Text.Hastache
|
||||||
|
@ -22,6 +22,8 @@ import System.Directory
|
||||||
import System.FilePath.Posix (takeDirectory,(</>))
|
import System.FilePath.Posix (takeDirectory,(</>))
|
||||||
-- Execute external commands
|
-- Execute external commands
|
||||||
import System.Cmd (system)
|
import System.Cmd (system)
|
||||||
|
-- Random error message :)
|
||||||
|
import System.Random
|
||||||
|
|
||||||
-- Get external file of package
|
-- Get external file of package
|
||||||
import Paths_holy_project
|
import Paths_holy_project
|
||||||
|
@ -36,9 +38,28 @@ data Project = Project {
|
||||||
, synopsis :: String
|
, synopsis :: String
|
||||||
, year :: String } deriving (Data, Typeable)
|
, year :: String } deriving (Data, Typeable)
|
||||||
|
|
||||||
|
holyError :: String -> IO ()
|
||||||
|
holyError str = do
|
||||||
|
r <- randomIO
|
||||||
|
if r
|
||||||
|
then
|
||||||
|
do
|
||||||
|
bk "What... is your favourite colour?"
|
||||||
|
you "Blue. No, yel..."
|
||||||
|
putStrLn "[You are thrown over the edge into the volcano]"
|
||||||
|
you "You: Auuuuuuuuuuuugh"
|
||||||
|
bk " Hee hee heh."
|
||||||
|
else
|
||||||
|
do
|
||||||
|
bk "What is the capital of Assyria?"
|
||||||
|
you "I don't know that!"
|
||||||
|
putStrLn "[You are thrown over the edge into the volcano]"
|
||||||
|
you "Auuuuuuuuuuuugh"
|
||||||
|
hPutStrLn stderr ('\n':str)
|
||||||
|
|
||||||
ioassert :: Bool -> String -> IO ()
|
ioassert :: Bool -> String -> IO ()
|
||||||
ioassert True _ = return ()
|
ioassert True _ = return ()
|
||||||
ioassert False str = error str
|
ioassert False str = holyError str
|
||||||
|
|
||||||
-- | Ask, questions and create the initial project
|
-- | Ask, questions and create the initial project
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
@ -48,14 +69,12 @@ main = do
|
||||||
ioassert (checkProjectName project)
|
ioassert (checkProjectName project)
|
||||||
"Use only letters, numbers, spaces ans dashes please"
|
"Use only letters, numbers, spaces ans dashes please"
|
||||||
let projectname = projectNameFromString project
|
let projectname = projectNameFromString project
|
||||||
modulename = capitalize project
|
modulename = capitalize project
|
||||||
putStrLn $ "Project: " ++ projectname
|
in_author <- ask "name"
|
||||||
putStrLn $ "Module: " ++ modulename
|
in_email <- ask "email"
|
||||||
in_author <- ask "name"
|
in_ghaccount <- ask "github account"
|
||||||
in_email <- ask "email"
|
in_synopsis <- ask "project in less than a dozen word?"
|
||||||
in_ghaccount <- ask "github account"
|
current_year <- getCurrentYear
|
||||||
in_synopsis <- ask "project in less than a dozen word?"
|
|
||||||
current_year <- getCurrentYear
|
|
||||||
createProject $ Project projectname modulename in_author in_email
|
createProject $ Project projectname modulename in_author in_email
|
||||||
in_ghaccount in_synopsis current_year
|
in_ghaccount in_synopsis current_year
|
||||||
end
|
end
|
||||||
|
@ -146,6 +165,8 @@ genFile context filename outputFileName = do
|
||||||
createProject :: Project -> IO ()
|
createProject :: Project -> IO ()
|
||||||
createProject p = do
|
createProject p = do
|
||||||
let context = mkGenericContext p
|
let context = mkGenericContext p
|
||||||
|
dirExists <- doesDirectoryExist (projectName p)
|
||||||
|
ioassert (not dirExists) ((projectName p) ++ " directory already exists")
|
||||||
createDirectory (projectName p)
|
createDirectory (projectName p)
|
||||||
setCurrentDirectory (projectName p)
|
setCurrentDirectory (projectName p)
|
||||||
genFile context "gitignore" $ ".gitignore"
|
genFile context "gitignore" $ ".gitignore"
|
||||||
|
|
Loading…
Reference in a new issue