diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2013 Yann Esposito (Yogsototh) + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/holy-project.cabal b/holy-project.cabal new file mode 100644 --- /dev/null +++ b/holy-project.cabal @@ -0,0 +1,121 @@ +-- Initial holy-project.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +name: holy-project +version: 0.1.0.0 +synopsis: Start your Haskell project with cabal, git and tests. +description: Holy Project is an application wich ask the user + some questions and create files to help you + starting a new Haskell project. + There are example for tests using HUnit and SmallCheck + It initialize git, use cabal sandboxes, and provide + two useful scripts: \"auto-update\" and \"interact\". +homepage: http://github.com/yogsototh/holy-project +license: MIT +license-file: LICENSE +author: Yann Esposito (Yogsototh) +maintainer: Yann.Esposito@gmail.com +-- copyright: +category: Development +build-type: Simple +-- extra-source-files: +data-files: scaffold/LICENSE + , scaffold/Setup.hs + , scaffold/auto-update + , scaffold/gitignore + , scaffold/interact + , scaffold/project.cabal + , scaffold/src/Main.hs + , scaffold/src/ModuleName.hs + , scaffold/src/ModuleName/Swallow.hs + , scaffold/test/ModuleName/Swallow/Test.hs + , scaffold/test/Test.hs +cabal-version: >=1.10 + +source-repository head + type: git + branch: master + location: http://github.com/yogsototh/holy-project + +executable holy-project + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7 + , ansi-terminal + , split + , hastache + , bytestring + , syb + , directory + , time + , filepath + , process + , random + , http-conduit + , lens + , lens-aeson + , aeson + , text + -- from Tasty cabal with ansi-terminal + cpp-options: -DCOLORS + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +library + exposed-modules: HolyProject + , HolyProject.StringUtils + , HolyProject.GithubAPI + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7 + , ansi-terminal + , split + , hastache + , bytestring + , syb + , directory + , time + , filepath + , process + , random + , http-conduit + , lens + , lens-aeson + , aeson + , text + ghc-options: -Wall + hs-source-dirs: src + default-language: Haskell2010 + +executable test-holy-project + hs-source-dirs: test + ghc-options: -Wall + main-is: Test.hs + default-language: Haskell2010 + build-depends: base ==4.6.*, Cabal >= 1.16.0 + , holy-project + , HUnit + , QuickCheck + , smallcheck + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck + +test-suite Tests + hs-source-dirs: test + ghc-options: -Wall + main-is: Test.hs + Type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-depends: base ==4.6.*, Cabal >= 1.16.0 + , holy-project + , HUnit + , QuickCheck + , smallcheck + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck diff --git a/scaffold/LICENSE b/scaffold/LICENSE new file mode 100644 --- /dev/null +++ b/scaffold/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) {{year}} {{author}} + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/scaffold/Setup.hs b/scaffold/Setup.hs new file mode 100644 --- /dev/null +++ b/scaffold/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/scaffold/auto-update b/scaffold/auto-update new file mode 100644 --- /dev/null +++ b/scaffold/auto-update @@ -0,0 +1,51 @@ +#!/usr/bin/env zsh + +autoload colors +colors +for COLOR in RED GREEN YELLOW BLUE MAGENTA CYAN BLACK WHITE; do + eval $COLOR='$fg_no_bold[${(L)COLOR}]' + eval BOLD_$COLOR='$fg_bold[${(L)COLOR}]' +done +eval RESET='$reset_color' + +latestThread=0 +relaunchCompilation() { + while read line; do + if (( $( print -- $line | grep '.cabal-sandbox' | wc -l) == 0 )); then + (($latestThread>0)) && \ + (( $(ps x | awk "\$1 == $latestThread" | wc -l)>0 )) && { + print -- "\n${RED}STOPPED${RESET}" + kill $latestThread + } + print "${BLUE}$line${RESET}" + { cabal install && \ + ./.cabal-sandbox/bin/test-holy-project } & + latestThread=$! + fi + done +} + +echo "First launch" | relaunchCompilation +case $(uname) in +Darwin) + # On mac OS X, use hobbes (cabal install hobbes) + # launch a cabal install and cabal test after each + # small haskell file modification + {hobbes "*.hs" | relaunchCompilation } & + hobbes "*.cabal" | relaunchCompilation + ;; +*) # On other Unixes + tmp=$(date +"%s") + t=$tmp + while true; do + tmp=$(( $t - 1 )) + t=$(date +"%s") + for fic in {src,test}/**/*.hs(.) *.cabal; do + # note to use on OS X, use "stat -f %m $checkfile" instead + modtime=$(stat --printf %Y $fic) + (( $modtime > $tmp )) && print $fic + done + sleep 1 + done | relaunchCompilation + ;; +esac diff --git a/scaffold/gitignore b/scaffold/gitignore new file mode 100644 --- /dev/null +++ b/scaffold/gitignore @@ -0,0 +1,6 @@ +.cabal-sandbox +cabal.sandbox.config +dist +*.swp +*~ +.ghci diff --git a/scaffold/interact b/scaffold/interact new file mode 100644 --- /dev/null +++ b/scaffold/interact @@ -0,0 +1,15 @@ +#!/usr/bin/env zsh + +packagedir=( ./.cabal-sandbox/*.conf.d(/N) ) +(( ${#packagedir} == 0 )) && { + print -- "Error no package found in sandbox" + print -- "Please us cabal sandbox init" + exit 1 +}>&2 +(( ${#packagedir} > 1 )) && { + print -- "Error Too many packages:" + print -l -- $packagedir + exit 1 +}>&2 +export GHC_PACKAGE_PATH=$packagedir/: +GHC_PACKAGE_PATH=$packagedir/: ghci diff --git a/scaffold/project.cabal b/scaffold/project.cabal new file mode 100644 --- /dev/null +++ b/scaffold/project.cabal @@ -0,0 +1,73 @@ +-- Initial {{projectName}}.cabal generated by holy-project. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: {{projectName}} +version: 0.1.0.0 +synopsis: {{synopsis}} +-- description: +homepage: http://github.com/{{ghaccount}}/{{projectName}} +license: MIT +license-file: LICENSE +author: {{author}} +maintainer: {{mail}} +-- copyright: +category: Unknown +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +source-repository head + type: git + branch: master + location: http://github.com/{{ghaccount}}/{{projectName}} + +executable {{projectName}} + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7 + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +library + exposed-modules: {{moduleName}} + , {{moduleName}}.Swallow + , {{moduleName}}.Coconut + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7 + ghc-options: -Wall + hs-source-dirs: src + default-language: Haskell2010 + +executable test-{{projectName}} + hs-source-dirs: test + ghc-options: -Wall + main-is: Test.hs + default-language: Haskell2010 + build-depends: base ==4.6.*, Cabal >= 1.16.0 + , {{projectName}} + , HUnit + , QuickCheck + , smallcheck + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck + +test-suite Tests + hs-source-dirs: test + ghc-options: -Wall + main-is: Test.hs + Type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-depends: base ==4.6.*, Cabal >= 1.16.0 + , {{projectName}} + , HUnit + , QuickCheck + , smallcheck + , tasty + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck diff --git a/scaffold/src/Main.hs b/scaffold/src/Main.hs new file mode 100644 --- /dev/null +++ b/scaffold/src/Main.hs @@ -0,0 +1,6 @@ +module Main where +main :: IO () +main = do + putStrLn "You fight with the strength of many men sir Knight..." + putStrLn "You have proved yourself worthy; will you join me?" + putStrLn "You make me sad. So be it. Come, Patsy." diff --git a/scaffold/src/ModuleName.hs b/scaffold/src/ModuleName.hs new file mode 100644 --- /dev/null +++ b/scaffold/src/ModuleName.hs @@ -0,0 +1,3 @@ +module {{moduleName}} where +import {{moduleName}}.Swallow () +import {{moduleName}}.Coconut () diff --git a/scaffold/src/ModuleName/Swallow.hs b/scaffold/src/ModuleName/Swallow.hs new file mode 100644 --- /dev/null +++ b/scaffold/src/ModuleName/Swallow.hs @@ -0,0 +1,4 @@ +module {{moduleName}}.Swallow (swallow) where + +swallow :: String -> String -> String +swallow prefix suffix = prefix ++ suffix diff --git a/scaffold/test/ModuleName/Swallow/Test.hs b/scaffold/test/ModuleName/Swallow/Test.hs new file mode 100644 --- /dev/null +++ b/scaffold/test/ModuleName/Swallow/Test.hs @@ -0,0 +1,13 @@ +module {{moduleName}}.Swallow.Test + (swallowSuite) +where +import Test.Tasty (testGroup, TestTree) +import Test.Tasty.HUnit +import {{moduleName}}.Swallow + +swallowSuite :: TestTree +swallowSuite = testGroup "Swallow" + [testCase "swallow test" testSwallow] + +testSwallow :: Assertion +testSwallow = "something" @=? swallow "some" "thing" diff --git a/scaffold/test/Test.hs b/scaffold/test/Test.hs new file mode 100644 --- /dev/null +++ b/scaffold/test/Test.hs @@ -0,0 +1,15 @@ +module Main where + +import Test.Tasty (defaultMain,testGroup,TestTree) + +import {{moduleName}}.Swallow.Test +import {{moduleName}}.Coconut.Test + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "All Tests" + [ swallowSuite + , coconutSuite + ] diff --git a/src/HolyProject.hs b/src/HolyProject.hs new file mode 100644 --- /dev/null +++ b/src/HolyProject.hs @@ -0,0 +1,202 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module HolyProject where +import HolyProject.GitConfig ( getNameAndMailFromGitConfig) +import HolyProject.StringUtils ( projectNameFromString + , capitalize + , checkProjectName) +import HolyProject.GithubAPI ( searchGHUser) +import HolyProject.MontyPython ( bk + , you + , ask + ) + +-- Get current year for the License +import Data.Time.Clock +import Data.Time.Calendar +-- Hastache +import Data.Data +import Text.Hastache +import Text.Hastache.Context +-- File and directory Handling +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy.Char8 as LZ +import System.Directory +import System.FilePath.Posix (takeDirectory,()) +-- Execute external commands +import System.Cmd (system) +-- Random error message :) +import System.Random +-- Fork +import Control.Concurrent +-- Get external file of package +import Paths_holy_project + +import Data.Maybe (fromMaybe) +import Control.Monad (void) + +-- | Record containing all information to initialize a project +data Project = Project { + projectName :: String + , moduleName :: String + , author :: String + , mail :: String + , ghaccount :: String + , synopsis :: String + , year :: String } deriving (Data, Typeable) + +-- | Randomly choose an end scenario and then show a \"serious\" error message +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" + error ('\n':str) + +-- | Assert something true. In any other case show the holy error +ioassert :: Bool -> String -> IO () +ioassert True _ = return () +ioassert False str = holyError str + +-- | Ask, questions and create the initial project +holyStarter :: IO () +holyStarter = do + intro + (name,email) <- getNameAndMailFromGitConfig + earlyhint <- newEmptyMVar + maybe (putMVar earlyhint Nothing) -- if no email found put Nothing + (\hintmail -> -- in the other case ask the github API + void (forkIO (putMVar earlyhint =<< searchGHUser hintmail))) + email + project <- ask "project name" Nothing + ioassert (checkProjectName project) + "Use only letters, numbers, spaces ans dashes please" + let projectname = projectNameFromString project + modulename = capitalize project + in_author <- ask "name" name + in_email <- ask "email" email + ghUserHint <- if fromMaybe "" email /= in_email + then searchGHUser in_email + else takeMVar earlyhint + in_ghaccount <- ask "github account" ghUserHint + in_synopsis <- ask "project in less than a dozen word?" Nothing + current_year <- getCurrentYear + createProject $ Project projectname modulename in_author in_email + in_ghaccount in_synopsis current_year + end + +-- | Simply return the current year as String +getCurrentYear :: IO String +getCurrentYear = do + -- (current_year,_,_) <- getCurrentTime >>= return . toGregorian . utctDay + (current_year,_,_) <- fmap (toGregorian . utctDay) getCurrentTime + return (show current_year) + +-- | Show an introduction test +intro :: IO () +intro = do + bk "Stop!" + bk "Who would cross the Bridge of Death" + bk "must answer me these questions three," + bk "ere the other side he see." + you "Ask me the questions, bridgekeeper, I am not afraid.\n" + +-- | Show the final dialog +end :: IO () +end = do + putStrLn "\n\n" + bk "What... is the air-speed velocity of an unladen swallow?" + you "What do you mean? An African or European swallow?" + bk "Huh? I... I don't know that." + putStrLn "[the bridgekeeper is thrown over]" + bk "Auuuuuuuuuuuugh" + putStrLn "Sir Bedevere: How do you know so much about swallows?" + you "Well, you have to know these things when you're a king, you know." + +-- | This function use a Data file mustache template +-- and a hastache context to write a destination file +genFile :: MuContext IO -- ^ hastache context + -> String -- ^ Data file name (without 'scaffold/' see in .cabal) + -> FilePath -- ^ The destination file path + -> IO () +genFile context filename outputFileName = do + putStrLn $ '\t':outputFileName -- show the file name + template <- BS.readFile =<< getDataFileName ("scaffold/" ++ filename) + transformedFile <- hastacheStr defaultConfig template context + createDirectoryIfMissing True (takeDirectory outputFileName) + LZ.writeFile outputFileName transformedFile + +-- | This function is where we create the project once the +-- question are answered +createProject :: Project -> IO () +createProject p = do + -- create the hastache context object from the Project data type + let context = mkGenericContext p + -- Check if the directory doesn't already exists + dirExists <- doesDirectoryExist (projectName p) + ioassert (not dirExists) (projectName p ++ " directory already exists") + -- Create the directory and go into it + createDirectory (projectName p) + setCurrentDirectory (projectName p) + -- Generate all files using data files + mapM_ (uncurry (genFile context)) + [ ( "gitignore" + , ".gitignore" + ) + , ( "auto-update" + , "auto-update" + ) + , ( "LICENSE" + , "LICENSE" + ) + , ( "Setup.hs" + , "Setup.hs" + ) + , ( "interact" + , "interact" + ) + , ( "project.cabal" + , projectName p ++ ".cabal" + ) + , ( "src/Main.hs" + , "src" "Main.hs" + ) + , ( "src/ModuleName.hs" + , "src" (moduleName p++".hs") + ) + , ( "src/ModuleName/Coconut.hs" + , "src" moduleName p "Coconut.hs" + ) + , ( "src/ModuleName/Swallow.hs" + , "src" moduleName p "Swallow.hs" + ) + , ( "test/ModuleName/Coconut/Test.hs" + , "test" moduleName p "Coconut" "Test.hs" + ) + , ( "test/ModuleName/Swallow/Test.hs" + , "test" moduleName p "Swallow" "Test.hs" + ) + , ( "test/Test.hs" + , "test" "Test.hs" + ) + ] + -- Execute some commands + -- We don't really need them to be succesful + -- So we try them anyway + _ <- system "git init ." + _ <- system "cabal sandbox init" + _ <- system "cabal install" + _ <- system "cabal test" + _ <- system $ "./.cabal-sandbox/bin/test-" ++ projectName p + return () diff --git a/src/HolyProject/GithubAPI.hs b/src/HolyProject/GithubAPI.hs new file mode 100644 --- /dev/null +++ b/src/HolyProject/GithubAPI.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module HolyProject.GithubAPI + (searchGHUser) +where + +import qualified Data.ByteString.Lazy.Char8 as LZ +-- HTTP request and JSON handling +import Network.HTTP.Conduit +import Control.Lens.Operators ((^?)) +import Control.Lens.Aeson +import Data.Aeson.Encode (fromValue) +import qualified Data.Text.Lazy as TLZ +import qualified Data.Text.Lazy.Builder as TLB +import Control.Monad ((<=<)) + +-- | make a simple http request but add a user agent to the HTTP header +-- You HAVE TO add a User-Agent in your header to use the github API. +simpleHTTPWithUserAgent :: String -> IO LZ.ByteString +simpleHTTPWithUserAgent url = do + r <- parseUrl url + let request = r { requestHeaders = [ ("User-Agent","HTTP-Conduit") ] } + withManager $ (return.responseBody) <=< httpLbs request + +-- | Search a username using the github API +searchGHUser :: String -> IO (Maybe String) +searchGHUser "" = return Nothing +searchGHUser email = do + let url = "https://api.github.com/search/users?q=" ++ email + body <- simpleHTTPWithUserAgent url + let login = body ^? key "items" . nth 0 . key "login" + return $ fmap jsonValueToString login + where + jsonValueToString = TLZ.unpack . TLB.toLazyText . fromValue diff --git a/src/HolyProject/StringUtils.hs b/src/HolyProject/StringUtils.hs new file mode 100644 --- /dev/null +++ b/src/HolyProject/StringUtils.hs @@ -0,0 +1,28 @@ +module HolyProject.StringUtils +( projectNameFromString +, capitalize +, checkProjectName +) where + +-- Project name manipulation +import Data.Char (toUpper,toLower,isLetter,isNumber) +import Data.List (intercalate) +import Data.List.Split (splitOneOf) + +-- | transform a chain like "Holy project" in "holy-project" +projectNameFromString :: String -> String +projectNameFromString str = intercalate "-" (splitOneOf " -" (map toLower str)) + +-- | transform a chain like "Holy project" in "HolyProject" +capitalize :: String -> String +capitalize str = concatMap capitalizeWord (splitOneOf " -" str) + where + capitalizeWord :: String -> String + capitalizeWord (x:xs) = toUpper x:map toLower xs + capitalizeWord _ = [] + +-- | verify if a project name is conform +checkProjectName :: String -> Bool +checkProjectName [] = False +checkProjectName str = all (\c -> isLetter c || isNumber c || c=='-' || c==' ' ) str + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import HolyProject + +main :: IO () +main = holyStarter diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,15 @@ +module Main where + +import Test.Tasty (defaultMain,testGroup,TestTree) + +import HolyProject.StringUtils.Test +import HolyProject.GithubAPI.Test + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "All Tests" + [ stringUtilsSuite + , githubAPISuite + ]