キッチン計算

kitchen.hs

#!/usr/bin/env stack
-- stack --resolver lts-16.5 script --package mtl

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import           Numeric.Natural                ( Natural )
import           Data.List                      ( genericReplicate
                                                , genericLength
                                                )
import           Control.Monad                  ( when )
import           Control.Monad.State            ( MonadState
                                                , State
                                                , modify
                                                , gets
                                                , runState
                                                )

whileM :: Monad m => m Bool -> m ()
whileM act = do
  b <- act
  when b $ whileM act

data Plate
  = CleanPlate
  | UsedPlate

-- | Datatype representing kitchen's state
data Kitchen
  = Kitchen
  { plates :: [Plate]
  }

-- | Computation that runs on kitchen
newtype KitchenM a = KitchenM (State Kitchen a)
  deriving newtype (Functor, Applicative, Monad)
  deriving newtype (MonadState Kitchen)

-- | Obtain kitchen containing specified number of plates
kitchen :: Natural -> Kitchen
kitchen n = Kitchen { plates }
  where
    plates = genericReplicate n CleanPlate

-- | Run 'KitchenM' within specified number of plates
runKitchen :: Natural -> KitchenM a -> (a, Natural)
runKitchen numberOfPlates (KitchenM m) = (a, genericLength plates)
  where (a, Kitchen { plates }) = runState m (kitchen numberOfPlates)

-- | Is the kitchen clean?
isClean :: Kitchen -> Bool
isClean Kitchen { plates } = null plates

-- | Wash one plate
wash :: KitchenM ()
wash = modify $ f . plates
 where
   f (CleanPlate:rest) = f rest
   f (UsedPlate:rest) = Kitchen { plates = rest }
   f [] = Kitchen { plates = [] }

-- | Wash all plates
washAll :: KitchenM ()
washAll = whileM $ wash *> gets (not . isClean)

main :: IO ()
main = print unwashedPlates  -- 0
  where ((), unwashedPlates) = runKitchen 10 washAll