yogsototh/holy-project
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

QuickCheck SmallCheck and interact

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2013-12-03 16:54:56 +01:00
parent 9dd6b42216
commit c6b3225e4a
10 changed files with 66 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
holy-project.cabal
View file

@ -18,12 +18,11 @@ 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/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
@ -58,7 +57,6 @@ library
exposed-modules: HolyProject
, HolyProject.StringUtils
, HolyProject.GithubAPI
, HolyProject.Coconut
-- other-modules:
-- other-extensions:
build-depends: base >=4.6 && <4.7

15
interact Executable file
View file

@ -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

15
scaffold/interact Executable file
View file

@ -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

9
src/HolyProject.hs
View file

@ -4,7 +4,7 @@ import HolyProject.GitConfig ( getNameAndMailFromGitConfig)
import HolyProject.StringUtils ( projectNameFromString
, capitalize
, checkProjectName)
import HolyProject.GithubAPI ( searchGHUserFromEmail)
import HolyProject.GithubAPI ( searchGHUser)
import HolyProject.MontyPython ( bk
, you
, ask
@ -74,7 +74,7 @@ holyStarter = do
earlyhint <- newEmptyMVar
maybe (putMVar earlyhint Nothing) -- if no email found put Nothing
(\hintmail -> do -- in the other case ask the github API
forkIO (putMVar earlyhint =<< searchGHUserFromEmail hintmail)
forkIO (putMVar earlyhint =<< searchGHUser hintmail)
>> return ())
email
project <- ask "project name" Nothing
@ -85,7 +85,7 @@ holyStarter = do
in_author <- ask "name" name
in_email <- ask "email" email
ghUserHint <- if (maybe "" id email) /= in_email
then searchGHUserFromEmail 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
@ -160,6 +160,9 @@ createProject p = do
, ( "Setup.hs"
, "Setup.hs"
)
, ( "interact"
, "interact"
)
, ( "project.cabal"
, (projectName p) ++ ".cabal"
)

8
src/HolyProject/Coconut.hs
View file

@ -1,8 +0,0 @@
module HolyProject.Coconut (coconut,coconutfunc,CoconutDataStruct(..)) where
data CoconutDataStruct = CoconutConstr [Integer] deriving (Show)
coconut :: Integer
coconut = 10
coconutfunc :: CoconutDataStruct -> Int
coconutfunc (CoconutConstr l) = length l

8
src/HolyProject/GithubAPI.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module HolyProject.GithubAPI
(searchGHUserFromEmail)
(searchGHUser)
where
import qualified Data.ByteString.Lazy.Char8 as LZ
@ -25,9 +25,9 @@ simpleHTTPWithUserAgent url = do
-- | Ask the github API
-- A strange behaviour you HAVE TO add a User-Agent in your header.
-- It took me way too long to get this error
searchGHUserFromEmail :: String -> IO (Maybe String)
searchGHUserFromEmail "" = return Nothing
searchGHUserFromEmail email = do
searchGHUser :: String -> IO (Maybe String)
searchGHUser "" = return Nothing
searchGHUser email = do
let url = "https://api.github.com/search/users?q=" ++ email
body <- simpleHTTPWithUserAgent url
login <- return $ body ^? key "items" . nth 0 . key "login"

31
test/HolyProject/Coconut/Test.hs
View file

@ -1,31 +0,0 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module HolyProject.Coconut.Test
(coconutSuite)
where
import Test.Tasty (testGroup, TestTree)
import Test.Tasty.HUnit
import Test.Tasty.SmallCheck as SC
import HolyProject.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

17
test/HolyProject/GithubAPI/Test.hs
View file

@ -7,16 +7,15 @@ import HolyProject.GithubAPI
githubAPISuite :: TestTree
githubAPISuite = testGroup "GithubAPI"
[ testCase "Yann"
(ioTestEq
(searchGHUserFromEmail "Yann.Esposito@gmail.com")
(Just "\"yogsototh\""))
, testCase "Jasper"
(ioTestEq
(searchGHUserFromEmail "Jasper Van der Jeugt")
(Just "\"jaspervdj\""))
]
[ 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

31
test/HolyProject/StringUtils/Test.hs
View file

@ -1,22 +1,25 @@
module HolyProject.StringUtils.Test
( stringUtilsSuite
) where
import Test.Tasty (testGroup, TestTree)
import Test.Tasty.HUnit
import HolyProject.StringUtils
import Test.Tasty (testGroup, TestTree)
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
stringUtilsSuite :: TestTree
stringUtilsSuite = testGroup "StringUtils"
[ testGroup "projectNameFromString HUnit"
$ map (testEq projectNameFromString)
[ ("space","Holy Project","holy-project")
, ("empty","","")
, ("number","12345","12345")
]
[ SC.testProperty "SC projectNameFromString idempotent" $
idempotent projectNameFromString
, SC.testProperty "SC capitalize idempotent" $
deeperIdempotent capitalize
, QC.testProperty "QC projectNameFromString idempotent" $
idempotent capitalize
]
testEq :: (Eq a, Show a) =>
(t -> a) -- ^ Function to test
-> (String,t,a) -- ^ (name,input,expected output)
-> TestTree
testEq f (name,input,expected) = testCase name (f input @?= expected)
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)

2
test/Test.hs
View file

@ -4,7 +4,6 @@ import Test.Tasty (defaultMain,testGroup,TestTree)
import HolyProject.StringUtils.Test
import HolyProject.GithubAPI.Test
import HolyProject.Coconut.Test
main :: IO ()
main = defaultMain tests
@ -13,5 +12,4 @@ tests :: TestTree
tests = testGroup "All Tests"
[ stringUtilsSuite
, githubAPISuite
, coconutSuite
]