using quickcheck to simulate voltage curves

c_interface.cpp

#include "c_interface.h"
#include "voltage/VoltageManager.h"
#include "voltage/AbstractCriticalVoltageListener.h"
#include "TimeoutManagerMock.h"
#include <vector>
#include <iostream>
#include <algorithm>

using namespace power;
using namespace common;
using namespace mock;
using namespace std;

struct UnderVoltageListener : public AbstractUnderVoltageListener
{
    UnderVoltageListener(ITimeoutManager2& tm, uint16 level, IVoltageListener::Battery b, uint32 debouncetime, uint16 hysteresis) :
        AbstractUnderVoltageListener(tm, level,b,debouncetime),
        fBattery(b),
        fUnderVoltageOccuredCount(0),
        fUnderVoltageLeftCount(0)
    {
        setHysteresis(hysteresis);
    }
    virtual ~UnderVoltageListener() {}

    virtual void criticalVoltageEntered()
    {
        ++fUnderVoltageOccuredCount;
    }

    virtual void criticalVoltageLeft()
    {
        ++fUnderVoltageLeftCount;
    }

    IVoltageListener::Battery fBattery;
    int fUnderVoltageOccuredCount;
    int fUnderVoltageLeftCount;
};
int debounceTimeTest = 0;
class TestExecuter
{
public:
    TestExecuter()
    {
        fpListeners = new ListenerList();
    }

    ~TestExecuter()
    {
        remove_if(fpListeners->begin(),
                  fpListeners->end(),
                  [](UnderVoltageListener* x) -> bool { delete x; return true; });
        delete fpListeners;
    }

    void addListener(int threshold, int debounceTime, int hysteresis)
    {
        UnderVoltageListener* x = new UnderVoltageListener(tmMock, threshold, IVoltageListener::BATTERY_L1, debounceTime, hysteresis);
        fpListeners->push_back(x);
        voltageManager.registerUnderVoltageListener(*x);
    }

    TimeoutManagerMock  tmMock;
    VoltageManager voltageManager;
    typedef vector<UnderVoltageListener*> ListenerList;
    ListenerList* fpListeners;
};
TestExecuter* pTestExecuter = 0L;

TestExecuter& getTestExecuter()
{
    if (!pTestExecuter)
    {
        pTestExecuter = new TestExecuter();
    }
    return *pTestExecuter;
}

// implementation of FFI
void voltageEvent(int x)
{
    getTestExecuter().voltageManager.voltageChanged(x, IVoltageListener::BATTERY_L1);
}
void timeoutEvent()
{
    getTestExecuter().tmMock.alarmExpired();
}
int listenerVoltageState(int index)
{
    return (*(getTestExecuter().fpListeners))[index]->getVoltageState();
}
int underVoltageOccuredCount(int index)
{
    return (*(getTestExecuter().fpListeners))[index]->fUnderVoltageOccuredCount;
}
int underVoltageLeftCount(int index)
{
    return (*(getTestExecuter().fpListeners))[index]->fUnderVoltageLeftCount;
}
void addListener(int threshold, int debounceTime, int hysteresis)
{
    getTestExecuter().addListener(threshold, debounceTime, hysteresis);
}
void tearDownTestExecuter()
{
    if (pTestExecuter)
    {
        pTestExecuter = 0L;
    }
}

c_interface.h

extern "C" void voltageEvent(int);
extern "C" void timeoutEvent();
extern "C" int listenerVoltageState(int);
extern "C" int underVoltageOccuredCount(int);
extern "C" int underVoltageLeftCount(int);
extern "C" void addListener(int, int, int);
extern "C" void tearDownTestExecuter();

void voltageEvent(int);
void timeoutEvent();
int listenerVoltageState(int);
int underVoltageOccuredCount(int);
int underVoltageLeftCount(int);
void addListener(int, int, int);
void tearDownTestExecuter();

VoltageFFI.hs

{-# LANGUAGE ForeignFunctionInterface #-}
module VoltageFFI
  (
     voltageStateC
    ,addListenerC
    ,normal_voltage
    ,voltageChangeC
    ,c_timeoutEvent
    ,c_tearDown
  )
where

import Foreign
import Foreign.C.Types
import System.IO
import VoltageTests
import Control.Applicative

normal_voltage=0 :: Int
under_voltage_pending=1 :: Int
under_voltage=2 :: Int
hysteresis_voltag=3 :: Int

foreign import ccall "ftest.h voltageEvent"
     c_voltageEvent :: CInt -> IO ()
foreign import ccall "ftest.h timeoutEvent"
     c_timeoutEvent :: IO ()
foreign import ccall "ftest.h listenerVoltageState"
     c_voltageState :: CInt -> IO CInt
foreign import ccall "ftest.h underVoltageLeftCount"
     c_underVoltageLeftCount :: CInt -> IO CInt
foreign import ccall "ftest.h underVoltageOccuredCount"
     c_underVoltageCount :: CInt -> IO CInt
foreign import ccall "ftest.h addListener"
     c_addListener :: CInt -> CInt -> CInt -> IO ()
foreign import ccall "ftest.h tearDownTestExecuter"
     c_tearDown :: IO ()

voltageChangeC :: Int -> IO ()
voltageChangeC x = void $ c_voltageEvent (fromIntegral x)

voltageStateC :: Int -> IO (Int,Int,Int)
voltageStateC n = do
  finalState <- fromIntegral <$> c_voltageState (fromIntegral n)
  underVoltageCount <- fromIntegral <$> c_underVoltageCount (fromIntegral n)
  underVoltageLeftCount <- fromIntegral <$> c_underVoltageLeftCount (fromIntegral n)
  return (finalState,underVoltageCount,underVoltageLeftCount)

addListenerC :: VoltageListener -> IO ()
addListenerC (VL (a,b,c)) = c_addListener (fromIntegral a) (fromIntegral b) (fromIntegral c)

VoltageTests.hs

{-# LANGUAGE FlexibleInstances #-}
module VoltageTests where
import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import Control.Applicative
import Data.List(foldl')

data VoltageListener = VL (Int,Int,Int) deriving (Eq,Ord,Show)
instance Arbitrary VoltageListener where
  arbitrary = do
    threshold <- choose (5000,10000)
    debounce <- elements [0,100]
    hyst <- elements [0,100..500]
    return $ VL (threshold,debounce,hyst)

data Event = VoltageUpdate Int
                    | TimeoutEvent
                    | Register VoltageListener
                    | Deregister VoltageListener deriving(Eq,Ord)
instance Show Event where
  show (VoltageUpdate x) = show x
  show TimeoutEvent = "T"
  show (Register x) = "register " ++ show x
  show (Deregister x) = "deregister " ++ show x

instance Arbitrary Event where
  arbitrary = frequency [(2,VoltageUpdate <$> choose(1,16000)),
                         (1,return TimeoutEvent)]
instance Arbitrary [Event] where
  arbitrary = undefined

eventList :: Int -> Int -> (Int,Int) -> [Int] -> Gen [Event]
eventList n initial (a,b) r = do
    nextUpdates <- vectorOf n $ frequency [(a,elements r), (b,elements (map negate r))]
    let voltageUpdates = map VoltageUpdate $ reverse $ foldl' (\(prev:row) next->(prev+next):prev:row) [initial] nextUpdates
    altList <- alternateList (2*n) (1,10) -- timeouts/VoltageUpdate = 1/10
    return $ sprinkleTimeouts altList voltageUpdates

sprinkleTimeouts :: [Bool] -> [Event] -> [Event]
sprinkleTimeouts as es = reverse $ loop as es []
  where loop (True:ass) xs res = loop ass xs (TimeoutEvent:res)
        loop (False:ass) (x:xs) res = loop ass xs (x:res)
        loop _ [] res = res
        loop [] xs res = reverse xs ++ res
alternateList :: Int -> (Int,Int) -> Gen [Bool]
alternateList n (a,b) = vectorOf n $ frequency [(a,return True),(b,return False)]

data SlowRisingCurve = SlowRising [VoltageListener] [Event] deriving (Show)
instance Arbitrary SlowRisingCurve where
  arbitrary = do
    vs <- eventList 350 5000 (2,1) [100..150]
    listener <- arbitrary
    return $ SlowRising listener (cutAfter (>12500) vs)

data ErraticCurve = Erratic VoltageListener [Event] deriving (Show)
instance Arbitrary ErraticCurve where
  arbitrary = do
    vs <- vectorOf 150 arbitrary
    listener <- arbitrary
    return $ Erratic listener (vs ++ [VoltageUpdate 12000])

data RiseFallRiseCurve = RiseFallRise VoltageListener [Event] deriving (Show)
instance Arbitrary RiseFallRiseCurve where
  arbitrary = do
    vs <- eventList 130 5000 (2,1) [100..150]
    vs2 <- eventList 100 (lastVoltage vs) (1,2) [100..150]-- declining
    vs3 <- eventList 999 (lastVoltage vs2) (2,1) [100..150]
    let vs3' = cutAfter (>13000) vs3
    let vss = vs++vs2++vs3'
    listener <- arbitrary
    return $ RiseFallRise listener vss
      where lastVoltage xs = v
              where (VoltageUpdate v) = head $ filter isVoltageChange $ reverse xs

cutAfter ::  (Int -> Bool) -> [Event] -> [Event]
cutAfter f xs = let (a,b) = break changeIsBeyond xs in
    a ++ if null b then [] else [head b]
      where changeIsBeyond (VoltageUpdate u) = f u
            changeIsBeyond _ = False

cutBefore ::  (Int -> Bool) -> [Event] -> [Event]
cutBefore f xs = fst $ break changeIsBeyond xs
      where changeIsBeyond (VoltageUpdate u) = f u
            changeIsBeyond _ = False

data AbruptDropsCurve = AbruptDrops VoltageListener [Event] deriving (Show)
instance Arbitrary AbruptDropsCurve where
  arbitrary = do
    nextUpdates <- vectorOf 200 $ frequency [(10,choose (-50,50)), (1,choose (-11000,0))]
    let updates = foldl' (\row next->(12000+next):row) [] nextUpdates
    let voltageUpdates = map VoltageUpdate $ reverse updates
    altList <- alternateList 400 (1,10) -- timeouts/VoltageUpdate = 1/10
    let vss = sprinkleTimeouts altList voltageUpdates
    listener <- arbitrary
    return $ AbruptDrops listener (VoltageUpdate 12000:vss)
  shrink (AbruptDrops n (x:xs)) = map (AbruptDrops n . (x:)) (shrinkList shrink xs)
  shrink a = [a]

data SlowlyDecliningCurve = SlowDecline VoltageListener [Event] deriving (Show)
instance Arbitrary SlowlyDecliningCurve where
  arbitrary = do
    vs <- eventList 400 12000 (1,2) [1..200]
    listener <- arbitrary
    return $ SlowDecline listener (cutBefore (<0) vs)

data VoltageCurve5 = VC5 VoltageListener [Event] deriving (Show)
instance Arbitrary VoltageCurve5 where
  arbitrary = do
    vs <- eventList 5000 1000 (2,1) [1..10]
    let hyst = 100
    let vss = takeWhile (voltageBelow (2000+hyst+1)) vs ++ [VoltageUpdate (2000+hyst+1)]
    let listener = VL (2000,0,hyst)
    return $ VC5 listener vss
  shrink (VC5 _ (_:_:[])) = []
  shrink (VC5 x xs) = map (VC5 x) (shrinkList shrink xs)

voltageBelow x (VoltageUpdate y) = y < x
voltageBelow _ TimeoutEvent = True
voltageBelow _ _ = False

displayVC5 = do
  ss <- sample' arbitrary :: IO [VoltageCurve5]
  mapM_ printInfo ss

printInfo (VC5 _ vs) = do
  let fs = filter isVoltageChange vs
  let fss = map getVolt fs
  print fss

isVoltageChange (VoltageUpdate _) = True
isVoltageChange _ = False

getVolt (VoltageUpdate x) = x
getVolt x = error $ "no voltage for " ++ show x