HTF does not test props generated by TH - haskell

I want to do a number of similar tests on various types in my library.
To simplify things, assume I have a number of vector types implementing Num class, and I want to generate the same QuickCheck property check prop_absNorm x y = abs x + abs y >= abs (x+y) that would work on all of the types in library.
I generate such properties using TH:
$(writeTests
(\t ->
[d| prop_absNorm :: $(t) -> $(t) -> Bool
prop_absNorm x y = abs x + abs y >= abs (x+y)
|])
)
My function to generate tests has the following signature:
writeTests :: (TypeQ -> Q [Dec]) -> Q [Dec]
This function looks for all instances of my vector class VectorMath (n::Nat) t (and, at the same time, instances of Num) through reify ''VectorMath and generates all prop functions accordingly.
-ddump-splices shows something like this:
prop_absNormIntX4 :: Vector 4 Int -> Vector 4 Int -> Bool
prop_absNormIntX4 x y = abs x + abs y >= abs (x+y)
prop_absNormCIntX4 :: Vector 4 CInt -> Vector 4 CInt -> Bool
prop_absNormCIntX4 x y = abs x + abs y >= abs (x+y)
...
prop_absNormFloatX4 :: Vector 4 Float -> Vector 4 Float -> Bool
prop_absNormFloatX4 x y = abs x + abs y >= abs (x+y)
prop_absNormFloatX3 :: Vector 3 Float -> Vector 3 Float -> Bool
prop_absNormFloatX3 x y = abs x + abs y >= abs (x+y)
The problem is that all manually written properties are checked, but generated ones are not.
Note 1: I have generated and non-generated properties in the same file (i.e. TH expression $(..) is in the same file as the other props).
Note 2: the list of types for creation of prop functions is variable - I want to add other instances of VectorMath later, so they are automatically added into the test list.
I believe that the problem is that HTF (which presumably uses TH too) parses the original file, not the one with generated code - but I cannot get why this happens.
So my question is: how to solve this problem? If it is not possible to use TH-generated props, then is that possible to do QuickCheck tests on various types (i.e. that it substitutes them into prop_absNorm :: Vector 4 a -> Vector 4 a -> Bool)?
Also another alternative may be to use TH further to add test entries manually to htf_Main, but I have not figured out how to do this yet;
and it does not look like a nice clean solution.

If you know in advance what the names of the generated property tests are, then you could always manually define stubs so that HTF sees them, e.g.:
$(generate prop test for Int)
$(generate prop test for CInt)
prop_p1 = prop_absNormInt
prop_p2 = prop_absNormCInt
HTF will see the tests as prop_p1 and prop_p2. You shouldn't have to put type signatures on these stubs.
Another idea is to create your own source pre-processor to add these stubs for you (and give them better names). Your source pre-processor would automatically call htfpp to complete the pre-processing.
If you show me how your TH is invoked I can show you how to write the pre-processor.
Update:
Given your comment I would look at doing the following:
Write a program to generate the test module source.
Include that program and the output it generates in your cabal project.
Tell users to run the program if they want to update the test module.
So - the test cases remain fixed until the program is run to regenerate the test module.
Having a static test module has the advantage that you can tell exactly what is being tested.
Having a program to recreate the test module gives you the ability to easily update it when new Num instances become available.

Ok, I managed to solve this problem.
The idea is to use TH to aggregate the tests and insert them into htfMain.
On top of what I have in the question, this includes following steps:
Convert all testable properties into IO actions running QuickCheck tests;
Aggregate all tests into TestSuite;
Aggregate all test suites into one list and put it into htfMain.
In order to use step 1 I had to use semi-internal function of HTF called qcAssertion :: (QCAssertion t) => t -> Assertion.
This function is available, but not recommended for external use; it allows running QuickCheck tests nicely, integrating them into report.
To proceed with step 2, I use two functions from HTF: makeTestSuite and makeQuickCheckTest.
I also use location function from TH to provide filename and line of the place where the splice with test template is inserted (for nicer test logs).
Step 3 is a tricky one: for this we need to find all generated test suites.
The problem is that TH does not allow to browse through all functions (including generated) in a module.
To overcome this, I added following type class:
class MultitypeTestSuite name where
multitypeTestSuite :: name -> TestSuite
So my function writeTests generates a new data type data MTS[prop_name] and an instance of MultitypeTestSuite for that data type.
This allows me later to use another splice function in htfMain that will generate a list of test suites out of instances of that class using reify:
aggregateTests :: ExpQ
aggregateTests = do
ClassI _ instances <- reify ''MultitypeTestSuite
liftM ListE . forM instances
$ \... -> [e| multitypeTestSuite $(...) |]
In the end, including all generated tests together with manually written ones looks pretty simple:
main :: IO ()
main = htfMain $ htf_importedTests ++ $(aggregateTests)
So, by adjusting function $(writeTests) I am able now to generate and test properties that vary in argument type - for all types available in scope at the same type.
Test results and logs are included the same way as original tests.
On that the problem is fully solved.

HTF does not use TemplateHaskell for collecting the tests , this would slow down compilation-time significantly. Instead, HTF uses a custom preprocessor called htfpp. htfpp runs before the compiler (and thus before TemplateHaskell splices are expanded). This means that you cannot use automatic test discovery with htfpp when generating your tests with TemplateHaskell.
My suggestion: when you are using TemplateHaskell anyway, then just use TemplateHaskell to collect your generated test cases. This functionality is not built into HTF, but it's not difficult to implement such a function. Here is it:
-- file TH.hs
{-# LANGUAGE TemplateHaskell #-}
module TH ( genTestSuiteFromQcProps ) where
import Language.Haskell.TH
import Test.Framework
import Test.Framework.Location
genTestSuiteFromQcProps :: String -> [Name] -> Q Exp
genTestSuiteFromQcProps suiteName names =
[| makeTestSuite $(stringE suiteName) $(listE genTests) |]
where
genTests :: [ExpQ]
genTests =
map genTest names
genTest :: Name -> Q Exp
genTest name =
[| makeQuickCheckTest $(stringE (show name)) unknownLocation
(qcAssertion $(varE name)) |]
The function genTestSuiteFromQcProps takes the name of the test suite to generated and a list of names, referring to your QC properties. genTestSuiteFromQcProps returns an expression of type TestSuite. TestSuite is one of the types HTF uses to organize tests.
(The htfpp preprocessor als uses the TestSuite type in its output.)
Here is how you wold use genTestSuiteFromQcProps:
-- file Main.hs
{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import TH
import Test.Framework
import {-# HTF_TESTS #-} OtherTests
prop_additionCommutative :: Int -> Int -> Bool
prop_additionCommutative x y = (x + y) == (y + x)
prop_reverseReverseIdentity :: [Int] -> Bool
prop_reverseReverseIdentity l = l == reverse (reverse l)
myTestSuite :: TestSuite
myTestSuite =
$(genTestSuiteFromQcProps
"MyTestSuite"
['prop_additionCommutative
,'prop_reverseReverseIdentity])
main :: IO ()
main = htfMain (myTestSuite : htf_importedTests)
For your case, you would pass genTestSuiteFromQcProps the names of the QC properties you generated with TemplateHaskell.
The example also shows that you can mix test cases generated with the TemplateHaskell function with tests cases collected by htfpp. For completeness, here is the content of OtherTests:
{-# OPTIONS_GHC -F -pgmF htfpp #-}
module OtherTests ( htf_thisModulesTests) where
import Test.Framework
test_someOtherTest :: IO ()
test_someOtherTest =
assertEqual 1 1

Related

How to use Data.SBV to help derive correct stack machine implementation?

Graham Hutton, in the 2nd edition of Programming in Haskell, spends the last 2 chapters on the topic of stack machine based implementation of an AST.
And he finishes by showing how to derive the correct implementation of that machine from the semantic model of the AST.
I'm trying to enlist the help of Data.SBV in that derivation, and failing.
And I'm hoping that someone can help me understand whether I'm:
Asking for something that Data.SBV can't do, or
Asking Data.SBV for something it can do, but asking incorrectly.
-- test/sbv-stack.lhs - Data.SBV assisted stack machine implementation derivation.
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.SBV
import qualified Data.SBV.List as L
import Data.SBV.List ((.:), (.++)) -- Since they don't collide w/ any existing list functions.
-- AST Definition
data Exp = Val SWord8
| Sum Exp Exp
-- Our "Meaning" Function
eval :: Exp -> SWord8
eval (Val x) = x
eval (Sum x y) = eval x + eval y
type Stack = SList Word8
-- Our "Operational" Definition.
--
-- This function attempts to implement the *specification* provided by our
-- "meaning" function, above, in a way that is more conducive to
-- implementation in our available (and, perhaps, quite primitive)
-- computational machinery.
--
-- Note that we've (temporarily) assumed that this machinery will consist
-- of some form of *stack-based computation engine* (because we're
-- following Hutton's example).
--
-- Note that we give the *specification* of the function in the first
-- (commented out) line of the definition. The derivation of the actual
-- correct definition from this specification is detailed in Ch. 17 of
-- Hutton's book.
eval' :: Exp -> Stack -> Stack
-- eval' e s = eval e : s -- our "specification"
eval' (Val n) s = push n s -- We're defining this one manually.
where
push :: SWord8 -> Stack -> Stack
push n s = n .: s
eval' (Sum x y) s = add (eval' y (eval' x s))
where
add :: Stack -> Stack
add = uninterpret "add" s -- This is the function we're asking to be derived.
-- Now, let's just ask SBV to "solve" our specification of `eval'`:
spec :: Goal
spec = do x :: SWord8 <- forall "x"
y :: SWord8 <- forall "y"
-- Our spec., from above, specialized to the `Sum` case:
constrain $ eval' (Sum (Val x) (Val y)) L.nil .== eval (Sum (Val x) (Val y)) .: L.nil
We get:
λ> :l test/sbv-stack.lhs
[1 of 1] Compiling Main ( test/sbv-stack.lhs, interpreted )
Ok, one module loaded.
Collecting type info for 1 module(s) ...
λ> sat spec
Unknown.
Reason: smt tactic failed to show goal to be sat/unsat (incomplete quantifiers)
What happened?!
Well, maybe, asking SBV to solve for anything other than a predicate (i.e. - a -> Bool) doesn't work?
The fundamental issue here is that you are mixing SMTLib's sequence logic and quantifiers. And the problem turns out to be too difficult for an SMT solver to handle. This sort of synthesis of functions is indeed possible if you restrict yourself to basic logics. (Bitvectors, Integers, Reals.) But adding sequences to the mix puts it into the undecidable fragment.
This doesn't mean z3 cannot synthesize your add function. Perhaps a future version might be able to handle it. But at this point you're at the mercy of heuristics. To see why, note that you're asking the solver to synthesize the following definition:
add :: Stack -> Stack
add s = v .: s''
where (a, s') = L.uncons s
(b, s'') = L.uncons s'
v = a + b
while this looks rather innocent and simple, it requires capabilities beyond the current abilities of z3. In general, z3 can currently synthesize functions that only make a finite number of choices on concrete elements. But it is unable to do so if the output depends on input for every choice of input. (Think of it as a case-analysis producing engine: It can conjure up a function that maps certain inputs to others, but cannot figure out if something should be incremented or two things must be added. This follows from the work in finite-model finding theory, and is way beyond the scope of this answer! See here for details: https://arxiv.org/abs/1706.00096)
A better use case for SBV and SMT solving for this sort of problem is to actually tell it what the add function is, and then prove some given program is correctly "compiled" using Hutton's strategy. Note that I'm explicitly saying a "given" program: It would also be very difficult to model and prove this for an arbitrary program, but you can do this rather easily for a given fixed program. If you are interested in proving the correspondence for arbitrary programs, you really should be looking at theorem provers such as Isabelle, Coq, ACL2, etc.; which can deal with induction, a proof technique you will no doubt need for this sort of problem. Note that SMT solvers cannot perform induction in general. (You can use e-matching to simulate some induction like proofs, but it's a kludge at best and in general unmaintainable.)
Here's your example, coded to prove the \x -> \y -> x + y program is "correctly" compiled and executed with respect to reference semantics:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.SBV
import qualified Data.SBV.List as L
import Data.SBV.List ((.:))
-- AST Definition
data Exp = Val SWord8
| Sum Exp Exp
-- Our "Meaning" Function
eval :: Exp -> SWord8
eval (Val x) = x
eval (Sum x y) = eval x + eval y
-- Evaluation by "execution"
type Stack = SList Word8
run :: Exp -> SWord8
run e = L.head (eval' e L.nil)
where eval' :: Exp -> Stack -> Stack
eval' (Val n) s = n .: s
eval' (Sum x y) s = add (eval' y (eval' x s))
add :: Stack -> Stack
add s = v .: s''
where (a, s') = L.uncons s
(b, s'') = L.uncons s'
v = a + b
correct :: IO ThmResult
correct = prove $ do x :: SWord8 <- forall "x"
y :: SWord8 <- forall "y"
let pgm = Sum (Val x) (Val y)
spec = eval pgm
machine = run pgm
return $ spec .== machine
When I run this, I get:
*Main> correct
Q.E.D.
And the proof takes almost no time. You can easily extend this by adding other operators, binding forms, function calls, the whole works if you like. So long as you stick to a fixed "program" for verification, it should work out just fine.
If you make a mistake, let's say define add by subtraction (modify the last line of it to ready v = a - b), you get:
*Main> correct
Falsifiable. Counter-example:
x = 32 :: Word8
y = 0 :: Word8
I hope this gives an idea of what the current capabilities of SMT solvers are and how you can put them to use in Haskell via SBV.
Program synthesis is an active research area with many custom techniques and tools. An out of the box use of an SMT-solver will not get you there. But if you do build such a custom system in Haskell, you can use SBV to access an underlying SMT solver to solve many constraints you'll have to handle during the process.
(Aside: An extended example, similar in spirit but with different goals, is shipped with the SBV package: https://hackage.haskell.org/package/sbv-8.5/docs/Documentation-SBV-Examples-Strings-SQLInjection.html. This program shows how to use SBV and SMT solvers to find SQL injection vulnerabilities in an idealized SQL implementation. That might be of some interest here, and would be more aligned with how SMT solvers are typically used in practice.)

Moving from static configuration to dynamic configuration

I am working on a haskell project where the settings are currently in a file called Setting.hs, so they are checked during compile time and can be accessed globally.
However, since that is a bit too static, I was considering to read the configuration during runtime. The codebase is huge and it seems it would be considerable effort to pass the setting e.g. as an argument through the whole program flow, since they may be arbitrarily accessed from anywhere.
Are there any design patterns, libraries or even ghc extensions that can help here without refactoring the whole code?
Thanks for the hints! I came up with a minimal example which shows how I will go about it with the reflection package:
{-# LANGUAGE Rank2Types, FlexibleContexts, UndecidableInstances #-}
import Data.Reflection
data GlobalConfig = MkGlobalConfig {
getVal1 :: Int
, getVal2 :: Double
, getVal3 :: String
}
main :: IO ()
main = do
let config = MkGlobalConfig 1 2.0 "test"
-- initialize the program flow via 'give'
print $ give config (doSomething 2)
-- this works too, the type is properly inferred
print $ give config (3 + 3)
-- and this as well
print $ give config (addInt 7 3)
-- We need the Given constraint, because we call 'somethingElse', which finally
-- calls 'given' to retrieve the configuration. So it has to be propagated up
-- the program flow.
doSomething :: (Given GlobalConfig) => Int -> Int
doSomething = somethingElse "abc"
-- since we call 'given' inside the function to retrieve the configuration,
-- we need the Given constraint
somethingElse :: (Given GlobalConfig) => String -> Int -> Int
somethingElse str x
| str == "something" = x + getVal1 given
| getVal3 given == "test" = 0 + getVal1 given
| otherwise = round (fromIntegral x * getVal2 given)
-- no need for Given constraint here, since this does not use 'given'
-- or any other functions that would
addInt :: Int -> Int -> Int
addInt = (+)
The Given class is a bit easier to work with and perfectly suitable for a global configuration model. All functions that do not make use of given (which gets the value) don't seem to need the class constraint. That means I only have to change functions that actually access the global configuration.
That's what I was looking for.
What you are asking, if it was possible would break referential transparency, at least for pure function ( a pure function result can depend on some global variables but not on a config file couldn't it ) ?
Usually people avoid that type of situation by passing implicitly the configuration as data via a Monad. Alternatively (if you are happy to refactor your code a bit) you can use the implicit parameter extenson, which in theory has been made to solve that type of problem but in practice doesn't really work.
However, if you really need, you can use unsafePerformIO and ioRef to have a top level mutable state which is dirty and frowned upton. You need a top level mutable state, because you need to be able to modify "mutate" your initial config when you are loading it.
Then you get things like that :
myGlobalVar :: IORef Int
{-# NOINLINE myGlobalVar #-}
myGlobalVar = unsafePerformIO (newIORef 17)

How to avoid default return value when accessing a non-existent field with lenses?

I love Lens library and I love how it works, but sometimes it introduces so many problems, that I regret I ever started using it. Lets look at this simple example:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data Data = A { _x :: String, _y :: String }
| B { _x :: String }
makeLenses ''Data
main = do
let b = B "x"
print $ view y b
it outputs:
""
And now imagine - we've got a datatype and we refactor it - by changing some names. Instead of getting error (in runtime, like with normal accessors) that this name does not longer apply to particular data constructor, lenses use mempty from Monoid to create default object, so we get strange results instead of error. Debugging something like this is almost impossible.
Is there any way to fix this behaviour? I know there are some special operators to get the behaviour I want, but all "normal" looking functions from lenses are just horrible. Should I just override them with my custom module or is there any nicer method?
As a sidenote: I want to be able to read and set the arguments using lens syntax, but just remove the behaviour of automatic result creating when field is missing.
It sounds like you just want to recover the exception behavior. I vaguely recall that this is how view once worked. If so, I expect a reasonable choice was made with the change.
Normally I end up working with (^?) in the cases you are talking about:
> b ^? y
Nothing
If you want the exception behavior you can use ^?!
> b ^?! y
"*** Exception: (^?!): empty Fold
I prefer to use ^? to avoid partial functions and exceptions, similar to how it is commonly advised to stay away from head, last, !! and other partial functions.
Yes, I too have found it a bit odd that view works for Traversals by concatenating the targets. I think this is because of the instance Monoid m => Applicative (Const m). You can write your own view equivalent that doesn't have this behaviour by writing your own Const equivalent that doesn't have this instance.
Perhaps one workaround would be to provide a type signature for y, so know know exactly what it is. If you had this then your "pathological" use of view wouldn't compile.
data Data = A { _x :: String, _y' :: String }
| B { _x :: String }
makeLenses ''Data
y :: Lens' Data String
y = y'
You can do this by defining your own view1 operator. It doesn't exist in the lens package, but it's easy to define locally.
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data Data = A { _x :: String, _y :: String }
| B { _x :: String }
makeLenses ''Data
newtype Get a b = Get { unGet :: a }
instance Functor (Get a) where
fmap _ (Get x) = Get x
view1 :: LensLike' (Get a) s a -> s -> a
view1 l = unGet . l Get
works :: Data -> String
works = view1 x
-- fails :: Data -> String
-- fails = view1 y
-- Bug.hs:23:15:
-- No instance for (Control.Applicative.Applicative (Get String))
-- arising from a use of ‘y’

Can using UndecidableInstances pragma locally have global consequences on compilation termination?

Suppose a Haskell library designer decides to use UndecidableInstances for some reason. The library compiles fine. Now suppose some program uses the library (like defines some instances of its type classes), but doesn't use the extension. Can it happen that the compilation fails (doesn't terminate)?
If such a scenario can happen, I'd be happy to see an example. For example, as mtl uses UndecidableInstances a lot, is it possible to write a program that depends on mtl (or any other standard library that uses the extension), doesn't use UndecidableInstances itself, but fails to compile because of undecidability?
Great question!
In general this is certainly possible. Consider this module:
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
module M where
class C a b | a -> b where
f :: a -> b
instance C a b => C [a] [b]
where f = map f
It compiles by itself just fine. However, if you import this module and define
g x = x + f [x]
you'll get
Context reduction stack overflow; size = 201
Use -fcontext-stack=N to increase stack size to N
C [b] b
In the second argument of `(+)', namely `f [x]'
In the expression: x + f [x]
In an equation for `g': g x = x + f [x]
Regarding the mtl instances, I don't see how something like this is possible, but I also don't have a proof that it's not.

haskell load module in list

Hey haskellers and haskellettes,
is it possible to load a module functions in a list.
in my concrete case i have a list of functions all checked with or
checkRules :: [Nucleotide] -> Bool
checkRules nucs = or $ map ($ nucs) [checkRule1, checkRule2]
i do import checkRule1 and checkRule2 from a seperate module - i don't know if i will need more of them in the future.
i'd like to have the same functionality look something like
-- import all functions from Rules as rules where
-- :t rules ~~> [([Nucleotide] -> Bool)]
checkRules :: [Nucleotide] -> Bool
checkRules nucs = or $ map ($ nucs) rules
the program sorts Pseudo Nucleotide Sequences in viable and nonviable squences according to given rules.
thanks in advance ε/2
Addendum:
So do i think right - i need:
genList :: File -> TypeSignature -> [TypeSignature]
chckfun :: (a->b) -> TypeSignature -> Bool
at compile time.
but i can't generate a list of all functions in the module - as they most probably will have not the same type signature and hence not all fit in one list. so i cannot filter given list with chckfun.
In order to do this i either want to check the written type signatures in the source file (?) or the inferenced types given by the compiler(?).
another problem that comes to my mind is: not every function written in the source file might get exported ?
Is this a problem a haskell beginner should try to solve after 5 months of learning - my brain is shaped like a klein's bottle after all this "compile time thinking".
There is a nice package on Hackage just for this: language-haskell-extract. In particular, the Template Haskell function functionExtractor takes a regular expression and returns a list of the matching top level bindings as (name, value) pairs. As long as they all have matching types, you're good to go.
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.Extract
myFoo = "Hello"
myBar = "World"
allMyStuff = $(functionExtractor "^my")
main = print allMyStuff
Output:
[("myFoo", "Hello"), ("myBar", "World")]

Resources