Files
abacus/src/Abacus.hs
2024-08-21 14:34:46 -04:00

95 lines
2.3 KiB
Haskell

{-|
Module : Abacus
Description : Core functionality for a simple abacus program
Copyright : (C) Jonathan Lamothe
License : AGPL-3.0-or-later
Maintainer : jonathan@jlamothe.net
Stability : experimental
Portability : POSIX
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 (
Abacus,
newAbacus,
getNumBeads,
getNumRungs,
getRung,
setRung,
) where
import Data.List (find)
import Abacus.Internal
-- | Constructs the initial state of a new "Abacus"; will return
-- "Nothing" if the input paramebers are invalid.
newAbacus
:: Int
-- ^ The number of beads on each rung (must be at least one)
-> Int
-- ^ The number of rungs (must be at least one)
-> Maybe Abacus
newAbacus beads rungs = if beads < 1 || rungs < 1
then Nothing
else Just $ Abacus beads $ replicate rungs 0
-- | Returns the number of beads per rung in an "Abacus"
getNumBeads :: Abacus -> Int
getNumBeads = abacusNumBeads
-- | Returns the number of rungs in an "Abacus"
getNumRungs :: Abacus -> Int
getNumRungs = length . abacusRungs
-- | Returns the number of beads slid across a given rung
getRung
:: Int
-- ^ The rung number
-> Abacus
-- ^ Abacus being checked
-> Maybe Int
-- ^ The number of beads slid across (if the rung exists)
getRung r a = snd <$> find
(\(n, _) -> n == r)
(zip [0..] $ abacusRungs a)
-- | Sets the number of beads slid across a given rung
setRung
:: Int
-- ^ The rung number
-> Int
-- ^ The value being set
-> Abacus
-- ^ The original state
-> Abacus
-- ^ The new state
setRung r v a = a
{ abacusRungs = zipWith
(\n x -> if n == r then v' else x)
[0..]
(abacusRungs a)
}
where
v'
| v < 0 = 0
| v > getNumBeads a = getNumBeads a
| otherwise = v
--jl