abacus/test/Abacus/App/ActionsSpec.hs

{-

abacus
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public
License along with this program.  If not, see
<https://www.gnu.org/licenses/>.

-}

module Abacus.App.ActionsSpec (spec) where

import Lens.Micro.Platform ((&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)

import Abacus
import Abacus.Internal
import Abacus.App.Actions
import Abacus.App.Types

spec :: Spec
spec = describe "Actions" $ do
  moveUpSpec
  moveDownSpec
  topRungSpec
  bottomRungSpec
  selRungSpec
  beadLeftSpec
  beadRightSpec
  rungLeftSpec
  rungRightSpec

moveUpSpec :: Spec
moveUpSpec = describe "moveUp" $ mapM_
  ( \(desc, state, expected) -> context desc $
    it ("should be " ++ show expected) $
      moveUp state `shouldBe` expected
  )
  [ ( "at the top",     initialState, initialState )
  , ( "at the bottom",  atBottom,     movedUp      )
  , ( "somewhere else", elsewhere,    initialState )
  ]
  where
    atBottom  = initialState & rungNum .~ 9
    elsewhere = initialState & rungNum .~ 1
    movedUp   = initialState & rungNum .~ 8

moveDownSpec :: Spec
moveDownSpec = describe "moveDown" $ mapM_
  ( \(desc, state, expected) -> context desc $
    it ("should be " ++ show expected) $
      moveDown state `shouldBe` expected
  )
  [ ( "at the top",     initialState, movedDown )
  , ( "at the bottom",  atBottom,     atBottom  )
  , ( "somewhere else", elsewhere,    atBottom  )
  ]
  where
    atBottom  = initialState & rungNum .~ 9
    elsewhere = initialState & rungNum .~ 8
    movedDown = initialState & rungNum .~ 1

topRungSpec :: Spec
topRungSpec = describe "topRung" $ let
  state = initialState & rungNum .~ 5
  in it ("should be " ++ show initialState) $
    topRung state `shouldBe` initialState

bottomRungSpec :: Spec
bottomRungSpec = describe "bottomRung" $ let
  expected = initialState & rungNum .~ 9
  in it ("should be " ++ show expected) $
    bottomRung initialState `shouldBe` expected

selRungSpec :: Spec
selRungSpec = describe "selRung" $ mapM_
  ( \(desc, rung, expected) -> context desc $
    it ("should be " ++ show expected) $
      selRung rung initialState `shouldBe` expected
  )
  [ ( "negative rung", -1, initialState )
  , ( "valid rung",     5, rung5        )
  , ( "large rung",    11, rung9        )
  ]
  where
    rung5 = initialState & rungNum .~ 5
    rung9 = initialState & rungNum .~ 9

beadLeftSpec :: Spec
beadLeftSpec = describe "beadLeft" $ let
  state = initialState
    & abacus .~ Abacus 10 [1..10]
    & rungNum .~ 5
  expected = state & abacus.rungL 5 .~ 5
  in it ("should be " ++ show expected) $
    beadLeft state `shouldBe` expected

beadRightSpec :: Spec
beadRightSpec = describe "beadRight" $ let
  state = initialState
    & abacus .~ Abacus 10 [1..10]
    & rungNum .~ 5
  expected = state & abacus.rungL 5 .~ 7
  in it ("should be " ++ show expected) $
    beadRight state `shouldBe` expected

rungLeftSpec :: Spec
rungLeftSpec = describe "rungLeft" $ let
  state = initialState
    & rungNum .~ 5
    & abacus .~ Abacus 10 [1..10]
  expected = state & abacus.rungL 5 .~ 0
  in it ("should be " ++ show expected) $
    rungLeft state `shouldBe` expected

rungRightSpec :: Spec
rungRightSpec = describe "rungRight" $ let
  state = initialState
    & rungNum .~ 5
    & abacus .~ Abacus 10 [1..10]
  expected = state & abacus.rungL 5 .~ 10
  in it ("should be " ++ show expected) $
    rungRight state `shouldBe` expected

--jl