1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
|
module Main where
import Termonad.Prelude
import Control.Lens ((^.))
import Hedgehog
( Gen
, Property
, PropertyT
, annotate
, annotateShow
, failure
, forAll
, property
, success
)
import Hedgehog.Gen (alphaNum, choice, int, string)
import Hedgehog.Range (constant, linear)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.Hedgehog (testProperty)
import Termonad.FocusList
( FocusList
, debugFL
, deleteFL
, emptyFL
, insertFL
, invariantFL
, isEmptyFL
, lensFocusListLen
, lookupFL
, removeFL
)
main :: IO ()
main = do
tests <- testsIO
defaultMain tests
testsIO :: IO TestTree
testsIO = do
pure $
testGroup
"tests"
[ testProperty "invariants in FocusList" testInvariantsInFocusList
]
testInvariantsInFocusList :: Property
testInvariantsInFocusList =
property $ do
numOfActions <- forAll $ int (linear 1 200)
let initialState = emptyFL
let strGen = string (constant 0 25) alphaNum
-- traceM "----------------------------------"
-- traceM $ "starting bar, numOfActions: " <> show numOfActions
runActions numOfActions strGen initialState
data Action a
= InsertFL Int a
| RemoveFL Int
| DeleteFL a
deriving (Eq, Show)
genInsertFL :: Gen a -> FocusList a -> Maybe (Gen (Action a))
genInsertFL valGen fl
| isEmptyFL fl = Just $ do
val <- valGen
pure $ InsertFL 0 val
| otherwise = Just $ do
let len = fl ^. lensFocusListLen
key <- int $ constant 0 len
val <- valGen
pure $ InsertFL key val
genRemoveFL :: FocusList a -> Maybe (Gen (Action a))
genRemoveFL fl
| isEmptyFL fl = Nothing
| otherwise = Just $ do
let len = fl ^. lensFocusListLen
keyToRemove <- int $ constant 0 (len - 1)
pure $ RemoveFL keyToRemove
genDeleteFL :: Show a => FocusList a -> Maybe (Gen (Action a))
genDeleteFL fl
| isEmptyFL fl = Nothing
| otherwise = Just $ do
let len = fl ^. lensFocusListLen
keyForItemToDelete <- int $ constant 0 (len - 1)
let maybeItemToDelete = lookupFL keyForItemToDelete fl
case maybeItemToDelete of
Nothing ->
let msg =
"Could not find item in focuslist even though " <>
"it should be there." <>
"\nkey: " <>
show keyForItemToDelete <>
"\nfocus list: " <>
debugFL fl
in error msg
Just item -> pure $ DeleteFL item
generateAction :: Show a => Gen a -> FocusList a -> Gen (Action a)
generateAction valGen fl = do
let generators =
catMaybes
[ genInsertFL valGen fl
, genRemoveFL fl
, genDeleteFL fl
]
case generators of
[] ->
let msg =
"No generators available for fl:\n" <>
debugFL fl
in error msg
_ -> do
choice generators
performAction :: Eq a => FocusList a -> Action a -> Maybe (FocusList a)
performAction fl (InsertFL key val) = insertFL key val fl
performAction fl (RemoveFL keyToRemove) = removeFL keyToRemove fl
performAction fl (DeleteFL valToDelete) = Just $ deleteFL valToDelete fl
runActions :: (Eq a, Monad m, Show a) => Int -> Gen a -> FocusList a -> PropertyT m ()
runActions i valGen startingFL
| i <= 0 = success
| otherwise = do
action <- forAll $ generateAction valGen startingFL
-- traceM $ "runActions, startingFL: " <> show startingFL
-- traceM $ "runActions, action: " <> show action
let maybeEndingFL = performAction startingFL action
case maybeEndingFL of
Nothing -> do
annotate "Failed to perform action."
annotateShow startingFL
annotateShow action
failure
Just endingFL ->
if invariantFL endingFL
then runActions (i - 1) valGen endingFL
else do
annotate "Ending FocusList failed invariants."
annotateShow startingFL
annotateShow action
annotateShow endingFL
failure
|