Search code examples
haskellfunctional-programmingmonadsmonad-transformersstate-monad

Applying changes to outer Monads in Haskell without using Transformer monads


I am trying to do something like the following where I want to return an error message in case the state of a State-Monad isn't fulfilling a certain condition, can it be done without using lift and ExceptT or other transformer monad?

type Log = State [String] ()

stateCheckDuplicate :: String -> Either String Log
stateCheckDuplicate elem = 
  Right (do 
    log <- get
    if lookup elem log /= Nothing then Left "Duplicate elements"
    else    
      (put (elem:log)))


Solution

  • If I understand what the stateCheckDuplicate should do, you need the type of stateCheckDuplicate isomorphic to String -> [String] -> Either String [String]. Then your implementation will look like this:

    stateCheckDuplicate :: String -> [String] -> Either String [String]
    stateCheckDuplicate msg logs
        | msg `elem` logs = Left "Duplicate elements"
        | otherwise       = Right $ msg : logs
    

    As you can see, there is nor State, nor ExceptT, nor liftXXX. But maybe there is one problem, this function is "hard" to compose with others functions. To solve this problem need understand what you try to do.


    Update on:

    Ok, so I want to use it for a sequence of operations within a do-block, such that the state (or in this case string) will be updated at every operation. Each of these operations could then in turn be handled using for instance mapM_ or the like. I want the function with this do-block to return the Left "Duplicate elements" if the State or String-function returns the Left part, otherwise the function with the do block shall return a completely other type, that could be Either String (Int, Int) or something else.

    For using this operation in do-block, the result type should be an instanca of class Monad. You can make your own type for this purpose.

    newtype LogM a = LogM { runLogM :: [String] -> (Either String a, [String]) }
    
    instance Functor LogM where
        fmap f m = LogM $ \log0 ->
            let (ex, log1) = runLogM m log0 in
            case ex of
                Right x  -> (Right $ f x, log1)
                Left err -> (Left err, log1)
    
    instance Applicative LogM where
        pure x = LogM $ \log -> (Right x, log)
        mf <*> mx = do
            f <- mf
            x <- mx
            pure $ f x
    
    instance Monad LogM where
        m >>= k = LogM $ \log0 ->
            let (ex, log1) = runLogM m log0 in
            case ex of
                Right x  -> runLogM (k x) log1
                Left err -> (Left err, log1)
    
    instance MonadState [String] LogM where
        state f = LogM $ \log0 ->
            let (x, log1) = f log0 in
            (Right x, log1)
    
    instance MonadError String LogM where
        throwError err = LogM $ \log -> (Left err, log)
        catchError m h = LogM $ \log0 ->
            let (ex, log1) = runLogM m log0 in
            case ex of
                Right x  -> (Right x, log1)
                Left err -> runLogM (h err) log1
    
    stateCheckDuplicate :: String -> LogM ()
    stateCheckDuplicate msg = do
        log <- get
        if msg `elem` log then
            throwError "Duplicate elements"
        else
            put $ msg : log
    

    But compare how easy it will be with transformers:

    type LogM = ExceptT String (State [String])
    
    stateCheckDuplicate :: String -> LogM ()
    stateCheckDuplicate msg = do
        log <- get
        if msg `elem` log then
            throwError "Duplicate elements"
        else
            put $ msg : log
    

    If you don't want type alias you can do like this:

    {-# LANGUAGE GeneralizedNewtypeDeriving #-} 
    
    newtype LogM a = LogM { runLogM :: ExceptT String (State [String]) a }
        deriving ( Functor, Applicative, Monad
                 , MonadState [String]
                 , MonadError String
                 )