{-# LANGUAGE RankNTypes #-}
module Test.DejaFu.Settings
(
Settings
, defaultSettings
, fromWayAndMemType
, Way
, defaultWay
, lway
, systematically
, randomly
, uniformly
, Bounds(..)
, PreemptionBound(..)
, FairBound(..)
, defaultBounds
, defaultPreemptionBound
, defaultFairBound
, noBounds
, LengthBound(..)
, llengthBound
, MemType(..)
, defaultMemType
, lmemtype
, Discard(..)
, ldiscard
, learlyExit
, lequality
, lsimplify
, lsafeIO
, lshowAborts
, ldebugShow
, ldebugPrint
, ldebugFatal
, get
, set
) where
import Control.Applicative (Const(..))
import Data.Functor.Identity (Identity(..))
import System.Random (RandomGen, randomR)
import Test.DejaFu.Internal (Settings(..), Way(..))
import Test.DejaFu.Types
defaultSettings :: Applicative n => Settings n a
defaultSettings :: forall (n :: * -> *) a. Applicative n => Settings n a
defaultSettings = Way -> MemType -> Settings n a
forall (n :: * -> *) a.
Applicative n =>
Way -> MemType -> Settings n a
fromWayAndMemType Way
defaultWay MemType
defaultMemType
fromWayAndMemType :: Applicative n => Way -> MemType -> Settings n a
fromWayAndMemType :: forall (n :: * -> *) a.
Applicative n =>
Way -> MemType -> Settings n a
fromWayAndMemType Way
way MemType
memtype = Settings
{ _way :: Way
_way = Way
way
, _lengthBound :: Maybe LengthBound
_lengthBound = Maybe LengthBound
forall a. Maybe a
Nothing
, _memtype :: MemType
_memtype = MemType
memtype
, _discard :: Maybe (Either Condition a -> Maybe Discard)
_discard = Maybe (Either Condition a -> Maybe Discard)
forall a. Maybe a
Nothing
, _debugShow :: Maybe (a -> String)
_debugShow = Maybe (a -> String)
forall a. Maybe a
Nothing
, _debugPrint :: Maybe (String -> n ())
_debugPrint = Maybe (String -> n ())
forall a. Maybe a
Nothing
, _debugFatal :: Bool
_debugFatal = Bool
False
, _earlyExit :: Maybe (Either Condition a -> Bool)
_earlyExit = Maybe (Either Condition a -> Bool)
forall a. Maybe a
Nothing
, _equality :: Maybe (a -> a -> Bool)
_equality = Maybe (a -> a -> Bool)
forall a. Maybe a
Nothing
, _simplify :: Bool
_simplify = Bool
False
, _safeIO :: Bool
_safeIO = Bool
False
, _showAborts :: Bool
_showAborts = Bool
False
}
defaultWay :: Way
defaultWay :: Way
defaultWay = Bounds -> Way
systematically Bounds
defaultBounds
lway :: Lens' (Settings n a) Way
lway :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Way -> f Way) -> Settings n a -> f (Settings n a)
lway Way -> f Way
afb Settings n a
s = (\Way
b -> Settings n a
s {_way = b}) (Way -> Settings n a) -> f Way -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Way -> f Way
afb (Settings n a -> Way
forall (n :: * -> *) a. Settings n a -> Way
_way Settings n a
s)
systematically
:: Bounds
-> Way
systematically :: Bounds -> Way
systematically = Bounds -> Way
Systematic
randomly :: RandomGen g
=> g
-> Int
-> Way
randomly :: forall g. RandomGen g => g -> Int -> Way
randomly = (g -> (Int, g)) -> g -> Int -> Way
forall g. RandomGen g => (g -> (Int, g)) -> g -> Int -> Way
Randomly ((g -> (Int, g)) -> g -> Int -> Way)
-> (g -> (Int, g)) -> g -> Int -> Way
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> g -> (Int, g)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
1, Int
50)
uniformly :: RandomGen g
=> g
-> Int
-> Way
uniformly :: forall g. RandomGen g => g -> Int -> Way
uniformly = (g -> (Int, g)) -> g -> Int -> Way
forall g. RandomGen g => (g -> (Int, g)) -> g -> Int -> Way
Randomly ((g -> (Int, g)) -> g -> Int -> Way)
-> (g -> (Int, g)) -> g -> Int -> Way
forall a b. (a -> b) -> a -> b
$ \g
g -> (Int
1, g
g)
defaultBounds :: Bounds
defaultBounds :: Bounds
defaultBounds = Bounds
{ boundPreemp :: Maybe PreemptionBound
boundPreemp = PreemptionBound -> Maybe PreemptionBound
forall a. a -> Maybe a
Just PreemptionBound
defaultPreemptionBound
, boundFair :: Maybe FairBound
boundFair = FairBound -> Maybe FairBound
forall a. a -> Maybe a
Just FairBound
defaultFairBound
}
defaultPreemptionBound :: PreemptionBound
defaultPreemptionBound :: PreemptionBound
defaultPreemptionBound = PreemptionBound
2
defaultFairBound :: FairBound
defaultFairBound :: FairBound
defaultFairBound = FairBound
5
noBounds :: Bounds
noBounds :: Bounds
noBounds = Bounds
{ boundPreemp :: Maybe PreemptionBound
boundPreemp = Maybe PreemptionBound
forall a. Maybe a
Nothing
, boundFair :: Maybe FairBound
boundFair = Maybe FairBound
forall a. Maybe a
Nothing
}
llengthBound :: Lens' (Settings n a) (Maybe LengthBound)
llengthBound :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe LengthBound -> f (Maybe LengthBound))
-> Settings n a -> f (Settings n a)
llengthBound Maybe LengthBound -> f (Maybe LengthBound)
afb Settings n a
s = (\Maybe LengthBound
b -> Settings n a
s {_lengthBound = b}) (Maybe LengthBound -> Settings n a)
-> f (Maybe LengthBound) -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LengthBound -> f (Maybe LengthBound)
afb (Settings n a -> Maybe LengthBound
forall (n :: * -> *) a. Settings n a -> Maybe LengthBound
_lengthBound Settings n a
s)
defaultMemType :: MemType
defaultMemType :: MemType
defaultMemType = MemType
TotalStoreOrder
lmemtype :: Lens' (Settings n a) MemType
lmemtype :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(MemType -> f MemType) -> Settings n a -> f (Settings n a)
lmemtype MemType -> f MemType
afb Settings n a
s = (\MemType
b -> Settings n a
s {_memtype = b}) (MemType -> Settings n a) -> f MemType -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemType -> f MemType
afb (Settings n a -> MemType
forall (n :: * -> *) a. Settings n a -> MemType
_memtype Settings n a
s)
ldiscard :: Lens' (Settings n a) (Maybe (Either Condition a -> Maybe Discard))
ldiscard :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe (Either Condition a -> Maybe Discard)
-> f (Maybe (Either Condition a -> Maybe Discard)))
-> Settings n a -> f (Settings n a)
ldiscard Maybe (Either Condition a -> Maybe Discard)
-> f (Maybe (Either Condition a -> Maybe Discard))
afb Settings n a
s = (\Maybe (Either Condition a -> Maybe Discard)
b -> Settings n a
s {_discard = b}) (Maybe (Either Condition a -> Maybe Discard) -> Settings n a)
-> f (Maybe (Either Condition a -> Maybe Discard))
-> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either Condition a -> Maybe Discard)
-> f (Maybe (Either Condition a -> Maybe Discard))
afb (Settings n a -> Maybe (Either Condition a -> Maybe Discard)
forall (n :: * -> *) a.
Settings n a -> Maybe (Either Condition a -> Maybe Discard)
_discard Settings n a
s)
learlyExit :: Lens' (Settings n a) (Maybe (Either Condition a -> Bool))
learlyExit :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe (Either Condition a -> Bool)
-> f (Maybe (Either Condition a -> Bool)))
-> Settings n a -> f (Settings n a)
learlyExit Maybe (Either Condition a -> Bool)
-> f (Maybe (Either Condition a -> Bool))
afb Settings n a
s = (\Maybe (Either Condition a -> Bool)
b -> Settings n a
s {_earlyExit = b}) (Maybe (Either Condition a -> Bool) -> Settings n a)
-> f (Maybe (Either Condition a -> Bool)) -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either Condition a -> Bool)
-> f (Maybe (Either Condition a -> Bool))
afb (Settings n a -> Maybe (Either Condition a -> Bool)
forall (n :: * -> *) a.
Settings n a -> Maybe (Either Condition a -> Bool)
_earlyExit Settings n a
s)
lequality :: Lens' (Settings n a) (Maybe (a -> a -> Bool))
lequality :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe (a -> a -> Bool) -> f (Maybe (a -> a -> Bool)))
-> Settings n a -> f (Settings n a)
lequality Maybe (a -> a -> Bool) -> f (Maybe (a -> a -> Bool))
afb Settings n a
s = (\Maybe (a -> a -> Bool)
b -> Settings n a
s {_equality = b}) (Maybe (a -> a -> Bool) -> Settings n a)
-> f (Maybe (a -> a -> Bool)) -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> a -> Bool) -> f (Maybe (a -> a -> Bool))
afb (Settings n a -> Maybe (a -> a -> Bool)
forall (n :: * -> *) a. Settings n a -> Maybe (a -> a -> Bool)
_equality Settings n a
s)
lsimplify :: Lens' (Settings n a) Bool
lsimplify :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Settings n a -> f (Settings n a)
lsimplify Bool -> f Bool
afb Settings n a
s = (\Bool
b -> Settings n a
s {_simplify = b}) (Bool -> Settings n a) -> f Bool -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
afb (Settings n a -> Bool
forall (n :: * -> *) a. Settings n a -> Bool
_simplify Settings n a
s)
lsafeIO :: Lens' (Settings n a) Bool
lsafeIO :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Settings n a -> f (Settings n a)
lsafeIO Bool -> f Bool
afb Settings n a
s = (\Bool
b -> Settings n a
s {_safeIO = b}) (Bool -> Settings n a) -> f Bool -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
afb (Settings n a -> Bool
forall (n :: * -> *) a. Settings n a -> Bool
_safeIO Settings n a
s)
lshowAborts :: Lens' (Settings n a) Bool
lshowAborts :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Settings n a -> f (Settings n a)
lshowAborts Bool -> f Bool
afb Settings n a
s = (\Bool
b -> Settings n a
s {_showAborts = b}) (Bool -> Settings n a) -> f Bool -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
afb (Settings n a -> Bool
forall (n :: * -> *) a. Settings n a -> Bool
_showAborts Settings n a
s)
ldebugShow :: Lens' (Settings n a) (Maybe (a -> String))
ldebugShow :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe (a -> String) -> f (Maybe (a -> String)))
-> Settings n a -> f (Settings n a)
ldebugShow Maybe (a -> String) -> f (Maybe (a -> String))
afb Settings n a
s = (\Maybe (a -> String)
b -> Settings n a
s {_debugShow = b}) (Maybe (a -> String) -> Settings n a)
-> f (Maybe (a -> String)) -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> String) -> f (Maybe (a -> String))
afb (Settings n a -> Maybe (a -> String)
forall (n :: * -> *) a. Settings n a -> Maybe (a -> String)
_debugShow Settings n a
s)
ldebugPrint :: Lens' (Settings n a) (Maybe (String -> n ()))
ldebugPrint :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Maybe (String -> n ()) -> f (Maybe (String -> n ())))
-> Settings n a -> f (Settings n a)
ldebugPrint Maybe (String -> n ()) -> f (Maybe (String -> n ()))
afb Settings n a
s = (\Maybe (String -> n ())
b -> Settings n a
s {_debugPrint = b}) (Maybe (String -> n ()) -> Settings n a)
-> f (Maybe (String -> n ())) -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (String -> n ()) -> f (Maybe (String -> n ()))
afb (Settings n a -> Maybe (String -> n ())
forall (n :: * -> *) a. Settings n a -> Maybe (String -> n ())
_debugPrint Settings n a
s)
ldebugFatal :: Lens' (Settings n a) Bool
ldebugFatal :: forall (n :: * -> *) a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Settings n a -> f (Settings n a)
ldebugFatal Bool -> f Bool
afb Settings n a
s = (\Bool
b -> Settings n a
s {_debugFatal = b}) (Bool -> Settings n a) -> f Bool -> f (Settings n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
afb (Settings n a -> Bool
forall (n :: * -> *) a. Settings n a -> Bool
_debugFatal Settings n a
s)
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s a = Lens s s a a
get :: Lens' s a -> s -> a
get :: forall s a. Lens' s a -> s -> a
get Lens' s a
lens = Const a s -> a
forall {k} a (b :: k). Const a b -> a
getConst (Const a s -> a) -> (s -> Const a s) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> s -> Const a s
Lens' s a
lens a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const
set :: Lens' s a -> a -> s -> s
set :: forall s a. Lens' s a -> a -> s -> s
set Lens' s a
lens a
a = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> (s -> Identity s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity a) -> s -> Identity s
Lens' s a
lens (\a
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
a)