checkConditions :: Int -> String
checkConditions x = case x of
  n | n > 5 && even n -> "Greater than 5 and even"
  _                   -> "Other cases"

let payStatusCondition = 
    case payStatus of
        Just ps | Just psInt <- readMaybe ps -> [ChargeLogPayStatus ==. psInt]
        _ -> []

lift :: Monad m => m a -> t m a

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State

example :: StateT Int IO ()
example = do
    lift $ putStrLn "This is lifted from IO"
    modify (+1)

liftM :: Monad m => (a -> b) -> m a -> m b

import Control.Monad (liftM)

example :: IO Int
example = liftM (+1) (return 41) -- 结果是 IO 42

import Control.Monad (liftM)

example :: IO Int
example = (+1) <$> (return 41) -- 结果是 IO 42

liftIO :: MonadIO m => IO a -> m a

import Control.Monad.IO.Class (liftIO)

example :: StateT Int IO ()
example = do
    liftIO $ putStrLn "This is an IO action"
    modify (+1)

class (MonadResource m, MonadLogger m) => MonadHandler m where
    type HandlerSite m
    type SubHandlerSite m
    liftHandler :: HandlerFor (HandlerSite m) a -> m a
    liftSubHandler :: SubHandlerFor (SubHandlerSite m) (HandlerSite m) a -> m a

instance MonadHandler (HandlerFor site) where
    type HandlerSite (HandlerFor site) = site
    type SubHandlerSite (HandlerFor site) = site
    liftHandler = id
    {-# INLINE liftHandler #-}
    liftSubHandler (SubHandlerFor f) = HandlerFor f
    {-# INLINE liftSubHandler #-}

import Data.Maybe (fromMaybe)

-- 如果值为 Nothing，将使用默认值 10
let result = fromMaybe 10 Nothing       -- 结果为 10
let result2 = fromMaybe 10 (Just 5)     -- 结果为 5

import Text.Read (readMaybe)

let parsedInt = readMaybe "123" :: Maybe Int  -- 结果为 Just 123
let parsedFail = readMaybe "abc" :: Maybe Int -- 结果为 Nothing

import Data.Maybe (mapMaybe)

-- 将字符串列表尝试转换为 Int，仅保留成功转换的结果
let result = mapMaybe readMaybe ["123", "abc", "456"]  -- 结果为 [123, 456]

import Data.Maybe (catMaybes)

let result = catMaybes [Just 1, Nothing, Just 2, Nothing, Just 3]  -- 结果为 [1, 2, 3]

let result = maybe 0 (*2) (Just 5)    -- 结果为 10
let result2 = maybe 0 (*2) Nothing    -- 结果为 0

hoistMaybe :: Bool -> a -> Maybe a
hoistMaybe condition value = if condition then Just value else Nothing

let result = hoistMaybe (5 > 3) "符合条件"     -- 结果为 Just "符合条件"
let result2 = hoistMaybe (5 < 3) "不符合条件"   -- 结果为 Nothing

-- 获取请求头的token
lookupBearerAuth :: Handler (Maybe String)
-- 根据key从redis查询value
getFromRedis :: String -> Handler (Maybe String)
-- 将user的json字符串转为数据
decodeUser :: String -> Handler (Maybe User)

getUser :: Handler (Maybe User)
getUser = do
    mToken <- lookupBearerAuth
    case mToken of
        Nothing -> return Nothing
        Just token -> do
            mUserJson <- getFromRedis token
            case mUserJson of
                Nothing -> return Nothing
                Just userJson -> decodeUser userJson

class Applicative m => Monad m where
    (>>=)  :: m a -> (a -> m b) -> m b  -- bind 操作符
    (>>)   :: m a -> m b -> m b          -- 序列操作
    return :: a -> m a                   -- 注入操作

data MyContainer a = MyContainer a

-- 为MyContainer实现Monad方法，定义>>=的逻辑
instance Monad MyContainer where
    (>>=)  :: MyContainer a -> (a -> MyContainer b) -> MyContainer b  -- bind 操作符
    MyContainer a >>= f =
        -- 额外的操作
        doSomeThing
        -- 将转换函数应用于a
        f a

-- 转换函数
appendB :: String -> MyContainer String
appendB str = MyContainer $ str ++ "B"

-- 使用MyContainer
test :: MyContainer String
test = MyContainer "A" >>= appendB

-- test2是test1的do写法
test2 :: MyContainer String
test2 = do
    a <- MyContainer "A"
    -- 执行了doSomething隐式操作
    appendB a

data MaybeT a = MaybeT
 { maybeTValue :: Maybe a
 }

instance Monad m => Monad MaybeT where
    return = MaybeT . Just

    -- 根据Monad的签名，可以推导出x和f的定义
    -- x: MaybeT a
    -- f: a -> MaybeT b
    x >>= f =
        let v = maybeTValue x
        in case v of
            -- 若value是nothing不处理
            Nothing -> return Nothing
            Just y  -> (f y)

newtype MaybeT m a = MaybeT { 
    runMaybeT :: m (Maybe a) 
}

-- (MaybeT m)的monad实现
instance Monad m => Monad (MaybeT m) where
    return = MaybeT . return . Just

    -- 根据Monad的签名，可以推导出x和f的定义
    -- x: MaybeT m a
    -- f: a -> MaybeT m b
    (>>=) x f = MaybeT $ do
        v <- runMaybeT x
        case v of
            Nothing -> return Nothing
            Just y  -> runMaybeT (f y)

getUser :: Handler (Maybe User)
getUser = runMaybeT $ do
    token <- MaybeT lookupBearerAuth
    -- 隐式执行判断
    userJson <- MaybeT $ getFromRedis token
    -- 隐式执行判断
    decodeUser userJson

import Control.Monad (mplus)

findValue :: Int -> Maybe String
findValue x
  | x == 1    = Just "One"
  | x == 2    = Just "Two"
  | otherwise = Nothing

test = findValue 1 `mplus` findValue 3  -- 结果为 Just "One"

import Control.Monad (guard)

filteredPairs :: [(Int, Int)]
filteredPairs = do
  x <- [1, 2]
  y <- [3, 4]
  guard (x + y > 4)  -- 仅保留和大于 4 的组合
  return (x, y)

-- 结果为 [(1, 4), (2, 3), (2, 4)]

filteredPairs :: [(Int, Int)]
filteredPairs = do
  x <- [1, 2]
  y <- [3, 4]
  return (x, y)

-- 没有concat的结果是[[(1, 3), (1, 4)], [(2, 3), (2, 4)]]的两个数组
-- 有了concat结果为 [(1, 3), (1, 4), (2, 3), (2, 4)]，实现了类似++的结果

instance MonadPlus [] where
    mzero = []           -- 表示一个空列表，类似于“没有结果”或“失败”
    mplus = (++)         -- 列表的组合操作，即将两个列表拼接在一起

instance Monad [] where
    return x = [x]
    xs >>= f = concatMap f xs  -- 使用 concatMap 包含了++的功能

guard        :: (MonadPlus m) => Bool -> m ()
guard True   =  return ()
guard False  =  mzero

import Control.Monad (guard)

filterEven :: [Int] -> [Int]
filterEven xs = do
  x <- xs
  guard (even x)  -- 保留偶数
  return x

-- 结果为 [2,4,6]，假设输入是 [1,2,3,4,5,6]

safeDivide :: Int -> Int -> Maybe Int
safeDivide _ 0 = Nothing
safeDivide x y = Just (x `div` y)

result = safeDivide 10 0 `mplus` safeDivide 10 2
-- 结果为 Just 5，因为第一个计算失败，尝试第二个

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleContexts #-}

module Lib
    ( someFunc
    ) where

import Control.Monad (liftM, ap)

-- Step 1: 定义 ReaderT 类型
newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }

-- Step 2: 实现 Functor 实例
instance Functor m => Functor (ReaderT r m) where
    fmap f (ReaderT r) = ReaderT $ \env -> fmap f (r env)

-- Step 3: 实现 Applicative 实例
instance Monad m => Applicative (ReaderT r m) where
    pure x = ReaderT $ \_ -> pure x
    (ReaderT f) <*> (ReaderT x) = ReaderT $ \env -> do
        func <- f env
        val  <- x env
        return (func val)

-- Step 4: 实现 Monad 实例
instance Monad m => Monad (ReaderT r m) where
    return x = ReaderT $ \_ -> return x
    (ReaderT r) >>= k = ReaderT $ \env -> do
        a <- r env
        let ReaderT r' = k a
        r' env

-- Step 5: 实现 MonadReader 类
class Monad m => MonadReader r m | m -> r where
    ask :: m r
    local :: (r -> r) -> m a -> m a

-- Step 6: 实现 ReaderT 的 MonadReader 实例
instance Monad m => MonadReader r (ReaderT r m) where
    ask = ReaderT return
    local f (ReaderT r) = ReaderT $ \env -> r (f env)

-- Step 7: 定义 someFunc 测试函数
testReaderT :: IO ()
testReaderT = do
    let reader = ReaderT $ \env -> return ("Environment: " ++ env)
    result <- runReaderT reader "TestEnv"
    putStrLn result
    
    let askReader = ask :: ReaderT String IO String
    env <- runReaderT askReader "TestEnv"
    putStrLn ("ask: " ++ env)
    
    let localReader = local (\env -> env ++ " Modified") askReader
    modifiedEnv <- runReaderT localReader "TestEnv"
    putStrLn ("local: " ++ modifiedEnv)

-- 修改后的 testMonadReader 函数，启用 FlexibleContexts
testMonadReader :: (MonadReader String m) => m String
testMonadReader = do
    env <- ask  -- 获取环境变量，这里 r 被具体化为 String
    let modifiedEnv = env ++ " Modified"
    return modifiedEnv

someFunc :: IO ()
someFunc = do
    -- 运行 ReaderT 测试
    testReaderT
    
    -- 运行使用 MonadReader 约束的测试
    let result = testMonadReader :: ReaderT String IO String
    modifiedEnv <- runReaderT result "TestEnv"
    putStrLn ("testMonadReader: " ++ modifiedEnv)

class MonadTrans t where
    lift :: Monad m => m a -> t m a

instance MonadTrans (ReaderT r) where
    lift ma = ReaderT $ \_ -> ma

class DictEnum a where
  dictLabel :: a -> Text
  dictValues :: [a]
  default dictValues :: (Enum a) => [a]
  dictValues = enumFrom (toEnum 0)

instance (DictEnum a) => ToJSON a where
  toJSON = object [ "label" .= dictLabel val
                  , "value" .= fromEnum val
                  ]

class DictEnum a where
  dictLabel :: a -> Text
  dictValues :: [a]
  default dictValues :: (Enum a) => [a]
  dictValues = enumFrom (toEnum 0)

defaultDictToJson :: (DictEnum a, Enum a) => a -> J.Value
defaultDictToJson val = object [ "label" .= dictLabel val
                      , "value" .= fromEnum val
                      ]

instance ToJSON ProficiencyEnum where
  toJSON = defaultDictToJson

newtype ServeFor site param a = ServeFor (ReaderT (ServiceContext site param) (HandlerFor site) a) 

class Monad m => MonadServe site param m where
    liftS :: ServeFor site param a -> m a

instance MonadServe site param (DbServeFor site param) where
    liftS = DbServeFor . lift

liftSDBS :: forall site param a. ServeFor site param a -> DbServeFor site param a
liftSDBS = liftS

test :: DbServeFor site param a
test po domain = do
    ServiceContext userId now _ <- (liftS ctx :: DbServeFor site param)

-- 添加TypeApplications 
test2 :: DbServeFor site param a
test2 po domain = do
    ServiceContext userId now _ <- liftS @site @param ctx

class Monad m => MonadServe m where
    type ServeSite m
    type ServeParam m
    liftS :: ServeFor (ServeSite m) (ServeParam m) a -> m a

instance MonadServe (DbServeFor site param) where
    type ServeSite (DbServeFor site param) = site
    type ServeParam (DbServeFor site param) = param
    liftS = DbServeFor . lift

-- site param m各自独立，没有关系
class Monad m => MonadServe site param m where
    liftS :: ServeFor site param a -> m a

-- ServeSite m和ServeParam m可以获取m的属性
class Monad m => MonadServe m where
    type ServeSite m
    type ServeParam m
    liftS :: ServeFor (ServeSite m) (ServeParam m) a -> m a

handleDBException :: SomeException -> HandlerFor site (Either DatabaseException a)
handleDBException e = 
    let eMsg = T.pack $ show e
        in
        if "Duplicate" `T.isInfixOf` eMsg
            then return $ Left DuplicateEntryException
            else return $ Left $ GeneralDatabaseException eMsg

tryDbAction :: YesodDB site a -> HandlerFor site (Either DatabaseException a)
tryDbAction dbAction = ( Right <$> dbAction) `catch` handleDBException

handleDBException :: Monad m => SomeException -> m (Either DatabaseException a)
handleDBException e = 
    let eMsg = T.pack $ show e
        in
        if "Duplicate" `T.isInfixOf` eMsg
            then return $ Left DuplicateEntryException
            else return $ Left $ GeneralDatabaseException eMsg

tryDbAction :: (Functor m, Monad m, MonadUnliftIO m) => m a -> m (Either DatabaseException a)
tryDbAction dbAction = ( Right <$> dbAction) `catch` handleDBException

newtype ServeFor site param a = ServeFor (ReaderT (ServiceContext param) (HandlerFor site) a)
    deriving (Functor, Applicative, Monad, MonadIO, MonadResource, MonadLogger)

newtype Monad m => ServeFor param m a = ServeFor (ReaderT (ServiceContext param) m a)