Haskell单子例子：Reader

在线运行平台：https://play.haskell.org/saved/dlqfIuhm

import Control.Monad (liftM, ap, when)
import System.IO (IO, putStrLn)

-- Definition of Resource
data Resource = Resource String
  deriving (Show, Eq)

-- Resource state management structure
data ResourceState = ResourceState {
    allocatedResources :: [Resource]  -- List of allocated resources
} deriving (Show)

-- ResourceMonad definition
newtype ResourceMonad a = ResourceMonad {
    runResourceMonad :: ResourceState -> IO (a, ResourceState)
}

-- Functor instance
instance Functor ResourceMonad where
    fmap = liftM

-- Applicative instance
instance Applicative ResourceMonad where
    pure x = ResourceMonad $ \s -> return (x, s)
    (<*>) = ap

-- Monad instance
instance Monad ResourceMonad where
    return = pure
    (ResourceMonad action) >>= f = ResourceMonad $ \s -> do
        (x, newState) <- action s
        runResourceMonad (f x) newState

-- Function to allocate a resource
allocateResource :: String -> ResourceMonad Resource
allocateResource name = ResourceMonad $ \s -> do
    putStrLn $ "Allocating resource: " ++ name
    let resource = Resource name
    return (resource, s { allocatedResources = resource : allocatedResources s })

-- Function to release a resource
releaseResource :: Resource -> ResourceMonad ()
releaseResource resource@(Resource name) = ResourceMonad $ \s -> do
    putStrLn $ "Releasing resource: " ++ name
    let filteredResources = filter (/= resource) (allocatedResources s)
    return ((), s { allocatedResources = filteredResources })

-- Function to use a resource that checks if the resource is still allocated
useResource :: Resource -> ResourceMonad String
useResource resource@(Resource name) = ResourceMonad $ \s -> do
    let resources = allocatedResources s
    if resource `elem` resources
        then do
            putStrLn $ "Using resource: " ++ name
            return ("Result from " ++ name, s)
        else do
            putStrLn $ "Error: Attempt to use a released or non-existent resource: " ++ name
            fail $ "Resource " ++ name ++ " is not available"  -- Properly handle this as an error.

-- Example using ResourceMonad
example :: ResourceMonad String
example = do
    res1 <- allocateResource "Resource1"
    res2 <- allocateResource "Resource2"
    -- releaseResource res1
    result1 <- useResource res1
    result2 <- useResource res2
    releaseResource res1
    releaseResource res2
    return (result1 ++ " and " ++ result2)

-- Main function to execute the ResourceMonad
main :: IO ()
main = do
    let initialState = ResourceState []
    (result, finalState) <- runResourceMonad example initialState
    putStrLn $ "Final result: " ++ result
    putStrLn $ "Final resource state: " ++ show finalState