File: Test.hs

package info (click to toggle)
haskell-termonad 0.2.1.0-2
  • links: PTS
  • area: main
  • in suites: buster
  • size: 268 kB
  • sloc: haskell: 1,892; makefile: 7
file content (147 lines) | stat: -rw-r--r-- 4,009 bytes parent folder | download
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