Merge pull request input-output-hk#90 from tvman99/fourth-iteration

Updated .cabal and working test samples
clientflows · Feb 15, 2023 · 453c1ca · 453c1ca
2 parents bd9e55c + d78ab32
commit 453c1ca
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 72 deletions.
diff --git a/code/Week02/Week02.cabal b/code/Week02/Week02.cabal
@@ -54,43 +54,23 @@ common common-all-tests
     import:           common-all
     build-depends:    QuickCheck
                     , tasty
+                    , tasty-hunit
                     , plutus-simple-model
 
------------------------------------------------------------------------------------------
--------------------------------------- WEEK 02 ------------------------------------------
+library
+    import:             common-all
+    hs-source-dirs:     lecture
+    exposed-modules:    Gift
+                      , Burn
+                      , FortyTwo
+                      , FortyTwoTyped
+                      , CustomTypes
 
-library gift
-    import:            common-all
-    hs-source-dirs:    lecture
-    other-modules:     Utils
-    exposed-modules:   Gift
-
-library burn
-    import:            common-all
-    hs-source-dirs:    lecture
-    other-modules:     Utils
-    exposed-modules:   Burn
-
-library fortytwo
-    import:            common-all
-    hs-source-dirs:    lecture
-    other-modules:     Utils
-    exposed-modules:   FortyTwo
-
-library fortytwotyped
-    import:            common-all
-    hs-source-dirs:    lecture
-    other-modules:     Utils
-    exposed-modules:   FortyTwoTyped
-
-library customtypes
-    import:            common-all
-    hs-source-dirs:    lecture
-    other-modules:     Utils
-    exposed-modules:   CustomTypes
+    other-modules:      Utils
 
 test-suite homework
-    import:           common-all-tests
-    type:             exitcode-stdio-1.0
-    main-is:          THomework.hs
-    hs-source-dirs:   tests, homework
+    import:             common-all-tests
+    type:               exitcode-stdio-1.0
+    main-is:            THomework.hs
+    hs-source-dirs:     tests
+                      , homework
diff --git a/code/Week02/tests/THomework.hs b/code/Week02/tests/THomework.hs
@@ -6,7 +6,8 @@ import Control.Monad (replicateM)
 import Plutus.Model
 import Plutus.V1.Ledger.Api
 import Prelude
-import Test.Tasty 
+import Test.Tasty
+import Test.Tasty.HUnit
 import Data.Functor (void)
 
 -- alocate 3 users with 1000 lovelaces each
@@ -16,42 +17,37 @@ setupUsers = replicateM 3 $ newUser $ ada (Lovelace 1000)
 main :: IO ()
 main = do
   defaultMain $ do
-    testGroup "All tests"
+    testGroup "Homework tests"
       [ 
-        --tests defaultBabbage
-        -- TODO: Add tests
+        -- tests defaultBabbage
       ]
 
-{-
-tests :: MockConfig -> TestTree
-tests cfg = do
-  testGroup
-    "Test simple user scripts"
-    [ good "Simple spend" simpleSpend
-    , bad "Not enough funds" notEnoughFunds
-    ]
-  where
-    good = check True
-    bad = check False
--}
-
-
-simpleSpend :: Run Bool
-simpleSpend = do
-  users <- setupUsers                -- create 3 users and assign each 1000 lovelaces
-  let [u1, u2, u3] = users           -- give names for users
-  sendValue u1 (adaValue 100) u2     -- send 100 lovelaces from user 1 to user 2
-  sendValue u2 (adaValue 100) u3     -- send 100 lovelaces from user 2 to user 3
-  isOk <- noErrors                   -- check that all TXs were accepted without errors
-  vals <- mapM valueAt users         -- read user values
-  pure $ and                         -- check test predicate
-    [ isOk
-     , vals == fmap adaValue [900, 1000, 1100]
-    ]
-
-notEnoughFunds :: Run Bool
-notEnoughFunds = do
-  users <- setupUsers
-  let [u1, u2, _u3] = users
-  void $ sendValue u1 (adaValue 10000) u2
-  noErrors
+-- tests :: MockConfig -> TestTree
+-- tests cfg = do
+--   testGroup
+--     "Test simple user scripts"
+--     [ good "Simple spend" simpleSpend
+--     , bad "Not enough funds" notEnoughFunds
+--     ]
+--   where
+--     good = check True
+--     bad = check False
+--     check res msg act = testCase msg $ fst (runMock act (initMock cfg $ adaValue 10_000_000)) @?= res
+
+-- simpleSpend :: Run Bool
+-- simpleSpend = do
+--   users <- setupUsers
+--   let [u1, u2, u3] = users
+--       val = adaValue 100
+--   checkBalance (gives u1 val u2) $ sendValue u1 val u2
+--   checkBalance (gives u2 val u3) $ sendValue u2 val u3
+--   isOk <- noErrors
+--   vals <- mapM valueAt users
+--   pure $ isOk && vals == fmap adaValue [900, 1000, 1100]
+
+-- notEnoughFunds :: Run Bool
+-- notEnoughFunds = do
+--   users <- setupUsers
+--   let [u1, u2, _u3] = users
+--   void $ sendValue u1 (adaValue 10000) u2
+--   noErrors