• inspired from https://wiki.haskell.org/All_About_Monads#A_physical_analogy_for_monads
• examples tested with GHC 8.10.4

module Main where
 
-- import liftM, and ap to create a Tray monad
import qualified Control.Monad as M (liftM, ap)
 
main :: IO ()
main = do
    -- execute the assemply line and print the result starting with a Log that is 300 mm in diameter, and 250 mm long
    print $ assemblyLine (Log 300 250)
    -- the same with other diameter, and length
    print $ assemblyLine (Log 200 250)
    -- the same with other diameter, and length
    print $ assemblyLine (Log 24 250)
    -- the same with other diameter, and length
    print $ assemblyLine (Log 250 99)
    -- the same with other diameter, and length
    print $ assemblyLine (Log 22 201)
    -- the same with other diameter, and length
    print $ assemblyLine (Log 29 201)
 
-- vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv --
-- the analogy of an assambly line
assemblyLine :: Wood -> Tray Packed
assemblyLine w = 
    do
        c   <- makeChopsticks w    -- Wood to Chopsticks
        c'  <- polishChopsticks c  -- ...to polished Chopsticks
        c'' <- wrapChopsticks c'   -- ...to packed Chopsticks
        return c''
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --
 
--------------------------------------------------------------------------------
--  Basic types
 
--------------------------------------------------------------------------------
--  Wood
 
data Wood = Log { nDiameterInMM :: Float,  nLengthInMM :: Float }
    deriving Show
 
--------------------------------------------------------------------------------
--  Chopsticks and its Quality
 
data Quality =  Sawn | Polished
    deriving Show
 
data Chopsticks = Chopsticks { nPieces :: Integer, nQuality :: Quality }
    deriving Show
 
--------------------------------------------------------------------------------
--  Packed with Wrapper or in a StorageBin
 
data Packed = Wrapper Chopsticks | StorageBin Chopsticks
    deriving Show
 
--------------------------------------------------------------------------------
--  worker functions of the basic types
-- NOTE: All of them can have different in put, but the output is always a Tray.
-- NOTE: See the data type Tray.
 
-- makes roughly shaped chopsticks out of wood
makeChopsticks :: Wood -> Tray Chopsticks
makeChopsticks w 
    | nGain > 0 = Contains (Chopsticks nGain Sawn)
    | (nLengthInMM w) < 200 = Empty "to short" 
    | otherwise = Empty "to small in diameter"
    where
         nGain 
            | (nLengthInMM w) >= 200 = (round ((((nDiameterInMM w) - 20) * (nLengthInMM w)) / (220 * 5)))
            | otherwise = 0
 
-- polishes chopsticks
polishChopsticks :: Chopsticks -> Tray Chopsticks
polishChopsticks c 
    | amount >= 1 = Contains (Chopsticks amount Polished)
    | otherwise = Empty "no chopsticks after polishing"
    where
        amount = floor (((fromIntegral (nPieces c)) :: Double) * 0.9)
 
-- wraps chopsticks
wrapChopsticks :: Chopsticks -> Tray Packed
wrapChopsticks c 
    | amount >= 50 = Contains (Wrapper (Chopsticks amount (nQuality c)))
    | amount <= 0 = Empty "no chopsticks at packing"
    | otherwise = Contains (StorageBin (Chopsticks amount (nQuality c)))
    where
        amount = floor (((fromIntegral (nPieces c)) :: Double) * 0.95)
 
 
--------------------------------------------------------------------------------
--  Tray
 
-- trays are either empty or contain a single item
data Tray x = Empty String | Contains x
    deriving Show
 
--------------------------------------------------------------------------------
--  Tray as instance of Monad
 
-- Tray is a monad
instance Functor Tray where
    fmap = M.liftM
 
instance Applicative Tray where
    pure = return
    (<*>) = M.ap
 
instance Monad Tray where
    Empty s       >>= _      = Empty s
    (Contains x) >>= worker = worker x
    return                  = Contains

Output:

Contains (Wrapper (Chopsticks {nPieces = 54, nQuality = Polished}))
Contains (StorageBin (Chopsticks {nPieces = 34, nQuality = Polished}))
Empty "no chopsticks after polishing"
Empty "to short"
Empty "to small in diameter"
Empty "no chopsticks at packing"