Revision 7ddd8e4c
b/Makefile.am | ||
---|---|---|
14 | 14 |
space := $(empty) $(empty) |
15 | 15 |
comma := , |
16 | 16 |
|
17 |
# Helper function to strip src/ and test/hs/ from a list |
|
18 |
strip_hsroot = $(patsubst src/%,%,$(patsubst test/hs/%,%,$(1))) |
|
19 |
|
|
17 | 20 |
# Use bash in order to be able to use pipefail |
18 | 21 |
SHELL=/bin/bash |
19 | 22 |
|
... | ... | |
76 | 79 |
test/hs/Test/Ganeti/HTools/Backend \ |
77 | 80 |
test/hs/Test/Ganeti/Query |
78 | 81 |
|
82 |
# Haskell directories without the roots (src, test/hs) |
|
83 |
HS_DIRS_NOROOT = $(filter-out src,$(filter-out test/hs,$(HS_DIRS))) |
|
84 |
|
|
79 | 85 |
DIRS = \ |
80 | 86 |
$(HS_DIRS) \ |
81 | 87 |
autotools \ |
... | ... | |
114 | 120 |
|
115 | 121 |
ALL_APIDOC_HS_DIRS = \ |
116 | 122 |
$(APIDOC_HS_DIR) \ |
117 |
$(APIDOC_HS_DIR)/Ganeti \ |
|
118 |
$(APIDOC_HS_DIR)/Ganeti/Block \ |
|
119 |
$(APIDOC_HS_DIR)/Ganeti/Block/Drbd \ |
|
120 |
$(APIDOC_HS_DIR)/Ganeti/Confd \ |
|
121 |
$(APIDOC_HS_DIR)/Ganeti/DataCollectors \ |
|
122 |
$(APIDOC_HS_DIR)/Ganeti/HTools \ |
|
123 |
$(APIDOC_HS_DIR)/Ganeti/HTools/Backend \ |
|
124 |
$(APIDOC_HS_DIR)/Ganeti/HTools/Program \ |
|
125 |
$(APIDOC_HS_DIR)/Ganeti/Query |
|
123 |
$(patsubst %,$(APIDOC_HS_DIR)/%,$(call strip_hsroot,$(HS_DIRS_NOROOT))) |
|
126 | 124 |
|
127 | 125 |
BUILDTIME_DIR_AUTOCREATE = \ |
128 | 126 |
scripts \ |
... | ... | |
590 | 588 |
src/Ganeti/Version.hs |
591 | 589 |
HS_BUILT_SRCS_IN = $(patsubst %,%.in,$(HS_BUILT_SRCS)) |
592 | 590 |
|
591 |
HS_LIBTESTBUILT_SRCS = $(HS_LIBTEST_SRCS) $(HS_BUILT_SRCS) |
|
592 |
|
|
593 | 593 |
$(RUN_IN_TEMPDIR): | stamp-directories |
594 | 594 |
|
595 | 595 |
doc/html/index.html: ENABLE_MANPAGES = |
... | ... | |
747 | 747 |
done |
748 | 748 |
endif |
749 | 749 |
|
750 |
$(HS_ALL_PROGS): %: %.hs $(HS_LIBTEST_SRCS) $(HS_BUILT_SRCS) Makefile
|
|
750 |
$(HS_ALL_PROGS): %: %.hs $(HS_LIBTESTBUILT_SRCS) Makefile |
|
751 | 751 |
@if [ "$(notdir $@)" = "test" ] && [ "$(HS_NODEV)" ]; then \ |
752 | 752 |
echo "Error: cannot run unittests without the development" \ |
753 | 753 |
" libraries (see devnotes.rst)" 1>&2; \ |
... | ... | |
1810 | 1810 |
--output $(CURDIR)/$(APIDOC_PY_DIR) |
1811 | 1811 |
|
1812 | 1812 |
.PHONY: hs-apidoc |
1813 |
hs-apidoc: $(HS_BUILT_SRCS) |
|
1813 |
hs-apidoc: $(APIDOC_HS_DIR)/index.html |
|
1814 |
|
|
1815 |
$(APIDOC_HS_DIR)/index.html: $(HS_LIBTESTBUILT_SRCS) Makefile |
|
1814 | 1816 |
@test -n "$(HSCOLOUR)" || \ |
1815 | 1817 |
{ echo 'HsColour' not found during configure; exit 1; } |
1816 | 1818 |
@test -n "$(HADDOCK)" || \ |
... | ... | |
1823 | 1825 |
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/HTools/hscolour.css |
1824 | 1826 |
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/Confd/hscolour.css |
1825 | 1827 |
set -e ; \ |
1826 |
cd src; \ |
|
1828 |
export LC_ALL=en_US.UTF-8; \ |
|
1829 |
OPTGHC="--optghc=-isrc --optghc=-itest/hs"; \ |
|
1827 | 1830 |
if [ "$(HS_NOCURL)" ]; \ |
1828 |
then OPTGHC="--optghc=$(HS_NOCURL)"; \ |
|
1829 |
else OPTGHC=""; \ |
|
1831 |
then OPTGHC="$$OPTGHC --optghc=$(HS_NOCURL)"; \ |
|
1830 | 1832 |
fi; \ |
1831 | 1833 |
if [ "$(HS_PARALLEL3)" ]; \ |
1832 | 1834 |
then OPTGHC="$$OPTGHC --optghc=$(HS_PARALLEL3)"; \ |
... | ... | |
1834 | 1836 |
if [ "$(HS_REGEX_PCRE)" ]; \ |
1835 | 1837 |
then OPTGHC="$$OPTGHC --optghc=$(HS_REGEX_PCRE)"; \ |
1836 | 1838 |
fi; \ |
1837 |
RELSRCS="$(HS_LIB_SRCS:src/%=%) $(patsubst src/%,%,$(filter src/%,$(HS_BUILT_SRCS)))"; \ |
|
1838 |
for file in $$RELSRCS; do \ |
|
1839 |
hfile=`echo $$file|sed 's/\\.hs$$//'`.html; \ |
|
1840 |
$(HSCOLOUR) -css -anchor $$file > ../$(APIDOC_HS_DIR)/$$hfile ; \ |
|
1839 |
for file in $(HS_LIBTESTBUILT_SRCS); do \ |
|
1840 |
f_nosrc=$${file##src/}; \ |
|
1841 |
f_notst=$${f_nosrc##test/hs/}; \ |
|
1842 |
f_html=$${f_notst%%.hs}.html; \ |
|
1843 |
$(HSCOLOUR) -css -anchor $$file > $(APIDOC_HS_DIR)/$$f_html ; \ |
|
1841 | 1844 |
done ; \ |
1842 |
$(HADDOCK) --odir ../$(APIDOC_HS_DIR) --html --ignore-all-exports -w \
|
|
1843 |
-t ganeti -p haddock-prologue \ |
|
1845 |
$(HADDOCK) --odir $(APIDOC_HS_DIR) --html --ignore-all-exports -w \ |
|
1846 |
-t ganeti -p src/haddock-prologue \
|
|
1844 | 1847 |
--source-module="%{MODULE/.//}.html" \ |
1845 | 1848 |
--source-entity="%{MODULE/.//}.html#%{NAME}" \ |
1846 | 1849 |
$$OPTGHC \ |
1847 |
$(filter-out Ganeti/HTools/ExtLoader.hs,$(HS_LIB_SRCS:src/%=%))
|
|
1850 |
$(HS_LIBTESTBUILT_SRCS)
|
|
1848 | 1851 |
|
1849 | 1852 |
.PHONY: TAGS |
1850 | 1853 |
TAGS: $(GENERATED_FILES) |
b/test/hs/Test/Ganeti/BasicTypes.hs | ||
---|---|---|
7 | 7 |
|
8 | 8 |
{- |
9 | 9 |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
|
|
11 | 11 |
|
12 | 12 |
This program is free software; you can redistribute it and/or modify |
13 | 13 |
it under the terms of the GNU General Public License as published by |
... | ... | |
56 | 56 |
|
57 | 57 |
-- * Test cases |
58 | 58 |
|
59 |
-- | Tests the functor identity law (fmap id == id). |
|
59 |
-- | Tests the functor identity law: |
|
60 |
-- |
|
61 |
-- > fmap id == id |
|
60 | 62 |
prop_functor_id :: Result Int -> Property |
61 | 63 |
prop_functor_id ri = |
62 | 64 |
fmap id ri ==? ri |
63 | 65 |
|
64 |
-- | Tests the functor composition law (fmap (f . g) == fmap f . fmap g). |
|
66 |
-- | Tests the functor composition law: |
|
67 |
-- |
|
68 |
-- > fmap (f . g) == fmap f . fmap g |
|
65 | 69 |
prop_functor_composition :: Result Int |
66 | 70 |
-> Fun Int Int -> Fun Int Int -> Property |
67 | 71 |
prop_functor_composition ri (Fun _ f) (Fun _ g) = |
68 | 72 |
fmap (f . g) ri ==? (fmap f . fmap g) ri |
69 | 73 |
|
70 |
-- | Tests the applicative identity law (pure id <*> v = v). |
|
74 |
-- | Tests the applicative identity law: |
|
75 |
-- |
|
76 |
-- > pure id <*> v = v |
|
71 | 77 |
prop_applicative_identity :: Result Int -> Property |
72 | 78 |
prop_applicative_identity v = |
73 | 79 |
pure id <*> v ==? v |
74 | 80 |
|
75 |
-- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w |
|
76 |
-- = u <*> (v <*> w)). |
|
81 |
-- | Tests the applicative composition law: |
|
82 |
-- |
|
83 |
-- > pure (.) <*> u <*> v <*> w = u <*> (v <*> w) |
|
77 | 84 |
prop_applicative_composition :: Result (Fun Int Int) |
78 | 85 |
-> Result (Fun Int Int) |
79 | 86 |
-> Result Int |
... | ... | |
83 | 90 |
v' = fmap apply v |
84 | 91 |
in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w) |
85 | 92 |
|
86 |
-- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)). |
|
93 |
-- | Tests the applicative homomorphism law: |
|
94 |
-- |
|
95 |
-- > pure f <*> pure x = pure (f x) |
|
87 | 96 |
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property |
88 | 97 |
prop_applicative_homomorphism (Fun _ f) x = |
89 | 98 |
((pure f <*> pure x)::Result Int) ==? pure (f x) |
90 | 99 |
|
91 |
-- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u). |
|
100 |
-- | Tests the applicative interchange law: |
|
101 |
-- |
|
102 |
-- > u <*> pure y = pure ($ y) <*> u |
|
92 | 103 |
prop_applicative_interchange :: Result (Fun Int Int) |
93 | 104 |
-> Int -> Property |
94 | 105 |
prop_applicative_interchange f y = |
95 | 106 |
let u = fmap apply f -- need to extract the actual function from Fun |
96 | 107 |
in u <*> pure y ==? pure ($ y) <*> u |
97 | 108 |
|
98 |
-- | Tests the applicative\/functor correspondence (fmap f x = pure f <*> x). |
|
109 |
-- | Tests the applicative\/functor correspondence: |
|
110 |
-- |
|
111 |
-- > fmap f x = pure f <*> x |
|
99 | 112 |
prop_applicative_functor :: Fun Int Int -> Result Int -> Property |
100 | 113 |
prop_applicative_functor (Fun _ f) x = |
101 | 114 |
fmap f x ==? pure f <*> x |
102 | 115 |
|
103 |
-- | Tests the applicative\/monad correspondence (pure = return and |
|
104 |
-- (<*>) = ap). |
|
116 |
-- | Tests the applicative\/monad correspondence: |
|
117 |
-- |
|
118 |
-- > pure = return |
|
119 |
-- |
|
120 |
-- > (<*>) = ap |
|
105 | 121 |
prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property |
106 | 122 |
prop_applicative_monad v f = |
107 | 123 |
let v' = pure v :: Result Int |
108 | 124 |
f' = fmap apply f -- need to extract the actual function from Fun |
109 | 125 |
in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v' |
110 | 126 |
|
111 |
-- | Tests the monad laws (return a >>= k == k a, m >>= return == m, m |
|
112 |
-- >>= (\x -> k x >>= h) == (m >>= k) >>= h). |
|
127 |
-- | Tests the monad laws: |
|
128 |
-- |
|
129 |
-- > return a >>= k == k a |
|
130 |
-- |
|
131 |
-- > m >>= return == m |
|
132 |
-- |
|
133 |
-- > m >>= (\x -> k x >>= h) == (m >>= k) >>= h |
|
113 | 134 |
prop_monad_laws :: Int -> Result Int |
114 | 135 |
-> Fun Int (Result Int) |
115 | 136 |
-> Fun Int (Result Int) |
... | ... | |
122 | 143 |
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h)) |
123 | 144 |
] |
124 | 145 |
|
125 |
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero). |
|
146 |
-- | Tests the monad plus laws: |
|
147 |
-- |
|
148 |
-- > mzero >>= f = mzero |
|
149 |
-- |
|
150 |
-- > v >> mzero = mzero |
|
126 | 151 |
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property |
127 | 152 |
prop_monadplus_mzero v (Fun _ f) = |
128 | 153 |
printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&. |
Also available in: Unified diff