Commit 7ddd8e4c authored by Iustin Pop's avatar Iustin Pop

Expand Haddock to run over test files as well

This patch does multiple enhancements to the way we build the Haddock
docs, motivated by the fact that if we don't run Haddock over test
files as well, bad formatting can be submitted and will accumulate
over time (without any checks).

The patch does:

- replace manual built ALL_APIDOC_HS_DIRS with automatically built one
  (from HS_DIRS)
- change Haddock so that it runs from the top directory (instead of
  from src/)
- change HsColour target file to be built via bash parameter
  substitution, rather than sed (I don't know how to do it in one go,
  so I use 2 intermediate variables)
- change 'hs-apidoc' target so that it depends on the real target
  file; in case no source file has been modified, running 'make
  hs-apidoc' twice will not result in two runs
- run HsColour/Haddock under en_US.UTF-8 locale, otherwise they can't
  parse correctly the Unicode chars in the test files

Additionally, wrong formatting (oops) in a test file has been
corrected.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichele Tartara <mtartara@google.com>
parent dde85e1e
......@@ -14,6 +14,9 @@ empty :=
space := $(empty) $(empty)
comma := ,
# Helper function to strip src/ and test/hs/ from a list
strip_hsroot = $(patsubst src/%,%,$(patsubst test/hs/%,%,$(1)))
# Use bash in order to be able to use pipefail
SHELL=/bin/bash
......@@ -76,6 +79,9 @@ HS_DIRS = \
test/hs/Test/Ganeti/HTools/Backend \
test/hs/Test/Ganeti/Query
# Haskell directories without the roots (src, test/hs)
HS_DIRS_NOROOT = $(filter-out src,$(filter-out test/hs,$(HS_DIRS)))
DIRS = \
$(HS_DIRS) \
autotools \
......@@ -114,15 +120,7 @@ DIRS = \
ALL_APIDOC_HS_DIRS = \
$(APIDOC_HS_DIR) \
$(APIDOC_HS_DIR)/Ganeti \
$(APIDOC_HS_DIR)/Ganeti/Block \
$(APIDOC_HS_DIR)/Ganeti/Block/Drbd \
$(APIDOC_HS_DIR)/Ganeti/Confd \
$(APIDOC_HS_DIR)/Ganeti/DataCollectors \
$(APIDOC_HS_DIR)/Ganeti/HTools \
$(APIDOC_HS_DIR)/Ganeti/HTools/Backend \
$(APIDOC_HS_DIR)/Ganeti/HTools/Program \
$(APIDOC_HS_DIR)/Ganeti/Query
$(patsubst %,$(APIDOC_HS_DIR)/%,$(call strip_hsroot,$(HS_DIRS_NOROOT)))
BUILDTIME_DIR_AUTOCREATE = \
scripts \
......@@ -590,6 +588,8 @@ HS_BUILT_SRCS = \
src/Ganeti/Version.hs
HS_BUILT_SRCS_IN = $(patsubst %,%.in,$(HS_BUILT_SRCS))
HS_LIBTESTBUILT_SRCS = $(HS_LIBTEST_SRCS) $(HS_BUILT_SRCS)
$(RUN_IN_TEMPDIR): | stamp-directories
doc/html/index.html: ENABLE_MANPAGES =
......@@ -747,7 +747,7 @@ install-exec-hook:
done
endif
$(HS_ALL_PROGS): %: %.hs $(HS_LIBTEST_SRCS) $(HS_BUILT_SRCS) Makefile
$(HS_ALL_PROGS): %: %.hs $(HS_LIBTESTBUILT_SRCS) Makefile
@if [ "$(notdir $@)" = "test" ] && [ "$(HS_NODEV)" ]; then \
echo "Error: cannot run unittests without the development" \
" libraries (see devnotes.rst)" 1>&2; \
......@@ -1810,7 +1810,9 @@ py-apidoc: epydoc.conf $(RUN_IN_TEMPDIR) $(GENERATED_FILES)
--output $(CURDIR)/$(APIDOC_PY_DIR)
.PHONY: hs-apidoc
hs-apidoc: $(HS_BUILT_SRCS)
hs-apidoc: $(APIDOC_HS_DIR)/index.html
$(APIDOC_HS_DIR)/index.html: $(HS_LIBTESTBUILT_SRCS) Makefile
@test -n "$(HSCOLOUR)" || \
{ echo 'HsColour' not found during configure; exit 1; }
@test -n "$(HADDOCK)" || \
......@@ -1823,10 +1825,10 @@ hs-apidoc: $(HS_BUILT_SRCS)
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/HTools/hscolour.css
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/Confd/hscolour.css
set -e ; \
cd src; \
export LC_ALL=en_US.UTF-8; \
OPTGHC="--optghc=-isrc --optghc=-itest/hs"; \
if [ "$(HS_NOCURL)" ]; \
then OPTGHC="--optghc=$(HS_NOCURL)"; \
else OPTGHC=""; \
then OPTGHC="$$OPTGHC --optghc=$(HS_NOCURL)"; \
fi; \
if [ "$(HS_PARALLEL3)" ]; \
then OPTGHC="$$OPTGHC --optghc=$(HS_PARALLEL3)"; \
......@@ -1834,17 +1836,18 @@ hs-apidoc: $(HS_BUILT_SRCS)
if [ "$(HS_REGEX_PCRE)" ]; \
then OPTGHC="$$OPTGHC --optghc=$(HS_REGEX_PCRE)"; \
fi; \
RELSRCS="$(HS_LIB_SRCS:src/%=%) $(patsubst src/%,%,$(filter src/%,$(HS_BUILT_SRCS)))"; \
for file in $$RELSRCS; do \
hfile=`echo $$file|sed 's/\\.hs$$//'`.html; \
$(HSCOLOUR) -css -anchor $$file > ../$(APIDOC_HS_DIR)/$$hfile ; \
for file in $(HS_LIBTESTBUILT_SRCS); do \
f_nosrc=$${file##src/}; \
f_notst=$${f_nosrc##test/hs/}; \
f_html=$${f_notst%%.hs}.html; \
$(HSCOLOUR) -css -anchor $$file > $(APIDOC_HS_DIR)/$$f_html ; \
done ; \
$(HADDOCK) --odir ../$(APIDOC_HS_DIR) --html --ignore-all-exports -w \
-t ganeti -p haddock-prologue \
$(HADDOCK) --odir $(APIDOC_HS_DIR) --html --ignore-all-exports -w \
-t ganeti -p src/haddock-prologue \
--source-module="%{MODULE/.//}.html" \
--source-entity="%{MODULE/.//}.html#%{NAME}" \
$$OPTGHC \
$(filter-out Ganeti/HTools/ExtLoader.hs,$(HS_LIB_SRCS:src/%=%))
$(HS_LIBTESTBUILT_SRCS)
.PHONY: TAGS
TAGS: $(GENERATED_FILES)
......
......@@ -7,7 +7,7 @@
{-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
......@@ -56,24 +56,31 @@ instance (Arbitrary a) => Arbitrary (Result a) where
-- * Test cases
-- | Tests the functor identity law (fmap id == id).
-- | Tests the functor identity law:
--
-- > fmap id == id
prop_functor_id :: Result Int -> Property
prop_functor_id ri =
fmap id ri ==? ri
-- | Tests the functor composition law (fmap (f . g) == fmap f . fmap g).
-- | Tests the functor composition law:
--
-- > fmap (f . g) == fmap f . fmap g
prop_functor_composition :: Result Int
-> Fun Int Int -> Fun Int Int -> Property
prop_functor_composition ri (Fun _ f) (Fun _ g) =
fmap (f . g) ri ==? (fmap f . fmap g) ri
-- | Tests the applicative identity law (pure id <*> v = v).
-- | Tests the applicative identity law:
--
-- > pure id <*> v = v
prop_applicative_identity :: Result Int -> Property
prop_applicative_identity v =
pure id <*> v ==? v
-- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w
-- = u <*> (v <*> w)).
-- | Tests the applicative composition law:
--
-- > pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
prop_applicative_composition :: Result (Fun Int Int)
-> Result (Fun Int Int)
-> Result Int
......@@ -83,33 +90,47 @@ prop_applicative_composition u v w =
v' = fmap apply v
in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w)
-- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)).
-- | Tests the applicative homomorphism law:
--
-- > pure f <*> pure x = pure (f x)
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property
prop_applicative_homomorphism (Fun _ f) x =
((pure f <*> pure x)::Result Int) ==? pure (f x)
-- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u).
-- | Tests the applicative interchange law:
--
-- > u <*> pure y = pure ($ y) <*> u
prop_applicative_interchange :: Result (Fun Int Int)
-> Int -> Property
prop_applicative_interchange f y =
let u = fmap apply f -- need to extract the actual function from Fun
in u <*> pure y ==? pure ($ y) <*> u
-- | Tests the applicative\/functor correspondence (fmap f x = pure f <*> x).
-- | Tests the applicative\/functor correspondence:
--
-- > fmap f x = pure f <*> x
prop_applicative_functor :: Fun Int Int -> Result Int -> Property
prop_applicative_functor (Fun _ f) x =
fmap f x ==? pure f <*> x
-- | Tests the applicative\/monad correspondence (pure = return and
-- (<*>) = ap).
-- | Tests the applicative\/monad correspondence:
--
-- > pure = return
--
-- > (<*>) = ap
prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property
prop_applicative_monad v f =
let v' = pure v :: Result Int
f' = fmap apply f -- need to extract the actual function from Fun
in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v'
-- | Tests the monad laws (return a >>= k == k a, m >>= return == m, m
-- >>= (\x -> k x >>= h) == (m >>= k) >>= h).
-- | Tests the monad laws:
--
-- > return a >>= k == k a
--
-- > m >>= return == m
--
-- > m >>= (\x -> k x >>= h) == (m >>= k) >>= h
prop_monad_laws :: Int -> Result Int
-> Fun Int (Result Int)
-> Fun Int (Result Int)
......@@ -122,7 +143,11 @@ prop_monad_laws a m (Fun _ k) (Fun _ h) =
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h))
]
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero).
-- | Tests the monad plus laws:
--
-- > mzero >>= f = mzero
--
-- > v >> mzero = mzero
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property
prop_monadplus_mzero v (Fun _ f) =
printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment