holy-project 0.1.0.0 → 0.1.0.1
raw patch · 7 files changed
+218/−1 lines, 7 files
Files
- holy-project.cabal +7/−1
- scaffold/src/ModuleName/Coconut.hs +8/−0
- scaffold/test/ModuleName/Coconut/Test.hs +31/−0
- src/HolyProject/GitConfig.hs +65/−0
- src/HolyProject/MontyPython.hs +42/−0
- test/HolyProject/GithubAPI/Test.hs +21/−0
- test/HolyProject/StringUtils/Test.hs +44/−0
holy-project.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: holy-project-version: 0.1.0.0+version: 0.1.0.1 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@@ -27,7 +27,9 @@ , scaffold/project.cabal , scaffold/src/Main.hs , scaffold/src/ModuleName.hs+ , scaffold/src/ModuleName/Coconut.hs , scaffold/src/ModuleName/Swallow.hs+ , scaffold/test/ModuleName/Coconut/Test.hs , scaffold/test/ModuleName/Swallow/Test.hs , scaffold/test/Test.hs cabal-version: >=1.10@@ -67,6 +69,8 @@ exposed-modules: HolyProject , HolyProject.StringUtils , HolyProject.GithubAPI+ other-modules: HolyProject.GitConfig+ , HolyProject.MontyPython -- other-modules: -- other-extensions: build-depends: base >=4.6 && <4.7@@ -93,6 +97,8 @@ hs-source-dirs: test ghc-options: -Wall main-is: Test.hs+ other-modules: HolyProject.GithubAPI.Test+ , HolyProject.StringUtils.Test default-language: Haskell2010 build-depends: base ==4.6.*, Cabal >= 1.16.0 , holy-project
+ scaffold/src/ModuleName/Coconut.hs view
@@ -0,0 +1,8 @@+module {{moduleName}}.Coconut (coconut,coconutfunc,CoconutDataStruct(..)) where+data CoconutDataStruct = CoconutConstr [Integer] deriving (Show)++coconut :: Integer+coconut = 10++coconutfunc :: CoconutDataStruct -> Int+coconutfunc (CoconutConstr l) = length l
+ scaffold/test/ModuleName/Coconut/Test.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module {{moduleName}}.Coconut.Test+ (coconutSuite)+where++import Test.Tasty (testGroup, TestTree)+import Test.Tasty.HUnit+import Test.Tasty.SmallCheck as SC++import {{moduleName}}.Coconut++-- Make instance of CoconutDataStruct+-- we simply use consN Constr where N is the arity of Constr (SmallCheck)+-- we also needed the+-- {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+import Test.SmallCheck.Series+instance Monad m => Serial m CoconutDataStruct where series = cons1 CoconutConstr+-- Now we could test properties with smallcheck on CoconutDataStruct type.++coconutSuite :: TestTree+coconutSuite = testGroup "coconut"+ [ testCase "coconut" testCoconut+ , SC.testProperty "coconut property" prop_coconut+ ]++testCoconut :: Assertion+testCoconut = coconut @=? 10++prop_coconut :: Property IO+prop_coconut = forAll $ \coconutStruct -> coconutfunc coconutStruct >= 0
+ src/HolyProject/GitConfig.hs view
@@ -0,0 +1,65 @@+module HolyProject.GitConfig+( getNameAndMailFromGitConfig+)+where++import qualified Data.ByteString.Lazy.Char8 as LZ+import Control.Monad (guard)+import Control.Exception+import System.IO.Error+import System.Environment (getEnv)++-- | Return name and email in gitconfig if found+getNameAndMailFromGitConfig :: IO (Maybe String, Maybe String)+getNameAndMailFromGitConfig = return . getNameAndMail =<< safeReadGitConfig++-- | return the content of ~/.gitconfig if it exists+-- if the HOME environment variable is not set+-- or the file doesn't exists+-- We return an empty string+safeReadGitConfig :: IO LZ.ByteString+safeReadGitConfig = do+ e <- tryJust (guard . isDoesNotExistError)+ (do+ home <- getEnv "HOME"+ LZ.readFile $ home ++ "/.gitconfig" )+ return $ either (const LZ.empty) id e++-- | Returns the name and email from the content of a .gitconfig file+-- almost equivalent to the two zsh lines:+--+-- > name="$(< ~/.gitconfig awk '$1 == name {shift 2; print}')"+-- > email="$(< ~/.gitconfig awk '$1 == email {shift 2; print}')"+--+-- But in Haskell it doesn't read the entire file.+-- The script after the first occurence of name and email.+getNameAndMail :: LZ.ByteString -> (Maybe String,Maybe String)+getNameAndMail gitConfigContent = (getFirstValueFor splitted "name",+ getFirstValueFor splitted "email")+ where+ -- make lines of words+ splitted :: [[LZ.ByteString]]+ splitted = map LZ.words (LZ.lines gitConfigContent)++-- | Get the first line which start with+-- 'elem =' and return the third field (value)+getFirstValueFor :: [[LZ.ByteString]] -> String -> Maybe String+getFirstValueFor splitted keyname = firstJust (map (getValueForKey keyname) splitted)++-- | return the first Just value of a list of Maybe+firstJust :: (Eq a) => [Maybe a] -> Maybe a+firstJust l = case dropWhile (==Nothing) l of+ [] -> Nothing+ (j:_) -> j++-- | Given a line of words ("word1":"word2":rest)+-- getValue will return rest if word1 == key+-- 'elem =' or Nothing otherwise+getValueForKey :: String -- key+ -> [LZ.ByteString] -- line of words+ -> Maybe String -- the value if found+getValueForKey el (n:e:xs) = if (n == LZ.pack el) && (e == LZ.pack "=")+ then Just (LZ.unpack (LZ.unwords xs))+ else Nothing+getValueForKey _ _ = Nothing+
+ src/HolyProject/MontyPython.hs view
@@ -0,0 +1,42 @@+module HolyProject.MontyPython+( bk+, you+, ask+)+where+-- Console read write with colors+import System.Console.ANSI+import System.IO (hFlush, stdout)+import Data.Maybe (fromJust,isJust)++-- | bridgekeeper speak+bk :: String -> IO ()+bk str = colorPutStr Green ("Bridgekeeper: " ++ str ++ "\n")+-- | the user dialog+you :: String -> IO ()+you str = colorPutStr Yellow ("Sir Yourself: " ++ str ++ "\n")++-- | show color+colorPutStr :: Color -> String -> IO ()+colorPutStr color str = do+ setSGR [ SetColor Foreground Dull color+ , SetConsoleIntensity NormalIntensity+ ]+ putStr str+ setSGR []++-- | Ask for some info and returns it+ask :: String -- ^ What? \"name\" for example+ -> Maybe String -- ^ Default value+ -> IO String+ask info hint = do+ bk $ "What is your " ++ info ++ "?" +++ maybe "" (\h -> " ("++h++")") hint+ putStr "> "+ hFlush stdout+ answer <- getLine+ putStrLn ""+ return $ if (answer == "") && isJust hint+ then fromJust hint+ else answer+
+ test/HolyProject/GithubAPI/Test.hs view
@@ -0,0 +1,21 @@+module HolyProject.GithubAPI.Test+( githubAPISuite+) where+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.HUnit+import HolyProject.GithubAPI++githubAPISuite :: TestTree+githubAPISuite = testGroup "GithubAPI"+ [ testCase "Yann" $ ioTestEq+ (searchGHUser "Yann.Esposito@gmail.com")+ (Just "\"yogsototh\"")+ , testCase "Jasper" $ ioTestEq+ (searchGHUser "Jasper Van der Jeugt")+ (Just "\"jaspervdj\"")+ ]++-- | Test if some IO action returns some expected value+ioTestEq :: (Eq a, Show a) => IO a -> a -> Assertion+ioTestEq action expected = action >>= assertEqual "" expected+
+ test/HolyProject/StringUtils/Test.hs view
@@ -0,0 +1,44 @@+module HolyProject.StringUtils.Test+( stringUtilsSuite+) where+import Data.Char (isPrint,isSymbol)+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.HUnit+import Test.Tasty.SmallCheck (forAll)+import qualified Test.Tasty.SmallCheck as SC+import qualified Test.Tasty.QuickCheck as QC+import Test.SmallCheck.Series (Serial)+import HolyProject.StringUtils++-- | Test with QuickCheck and SmallCheck+tp name prop = testGroup name+ [ QC.testProperty "QC" prop+ , SC.testProperty "SC" prop+ ]++stringUtilsSuite :: TestTree+stringUtilsSuite = testGroup "StringUtils"+ [ tp "projectNameFromString idempotent" $+ idempotent projectNameFromString+ , SC.testProperty "capitalize idempotent" $+ deeperIdempotent capitalize+ , tp "no space in project name" $+ \s -> ' ' `notElem` projectNameFromString s+ , tp "no space in capitalized name" $+ \s -> ' ' `notElem` capitalize s+ , tp "no dash in capitalized name" $+ \s -> '-' `notElem` capitalize s+ , tp "no control char" $+ \s -> not (checkProjectName s) || all isPrint s+ , tp "no symbol char" $+ \s -> not (checkProjectName s) || all (not . isSymbol) s+ , testCase "doesn't accept empty project name" $+ checkProjectName "" @=? False+ ]++idempotent :: (Eq a) => (a -> a) -> a -> Bool+idempotent f = \s -> f s == f (f s)++deeperIdempotent :: (Eq a, Show a, Serial m a) => (a -> a) -> SC.Property m+deeperIdempotent f = forAll $ SC.changeDepth1 (+1) $ \s -> f s == f (f s)+