path: root/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs

{-# OPTIONS_GHC -Wno-type-defaults #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.CharacterSpec (main, test) where
--------------------------------------------------------------------------------
import           Test.Prelude
import           Data.Vector.Lens (toVectorOf)
--------------------------------------------------------------------------------
import           Xanthous.Entities.Character
import           Xanthous.Util (endoTimes)
--------------------------------------------------------------------------------

main :: IO ()
main = defaultMain test

test :: TestTree
test = testGroup "Xanthous.Entities.CharacterSpec"
  [ testGroup "Knuckles"
    [ testBatch $ monoid @Knuckles mempty
    , testGroup "damageKnuckles"
      [ testCase "caps at 5" $
          let knuckles' = endoTimes 6 damageKnuckles mempty
          in _knuckleDamage knuckles' @?= 5
      ]
    ]
  , testGroup "Inventory"
    [ testProperty "items === itemsWithPosition . _2" $ \inv ->
        inv ^.. items === inv ^.. itemsWithPosition . _2
    , testGroup "removeItemFromPosition" $
      let rewield w inv =
            let (old, inv') = inv & wielded <<.~ w
            in inv' & backpack <>~ toVectorOf (wieldedItems . wieldedItem) old
      in [ (Backpack, \item -> backpack %~ (item ^. wieldedItem <|))
         , (LeftHand, rewield . inLeftHand)
         , (RightHand, rewield . inRightHand)
         , (BothHands, rewield . review doubleHanded)
         ] <&> \(pos, addItem) ->
           testProperty (show pos) $ \inv item ->
             let inv' = addItem item inv
                 inv'' = removeItemFromPosition pos (item ^. wieldedItem) inv'
             in inv'' ^.. items === inv ^.. items
    ]
  ]