{- |
Description: Postfix notation
Copyright: Copyright (C) 2022 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Some solutions to "Problems.P79" of Ninety-Nine Haskell "Problems".
-}
module Solutions.P79 (calculatePostfix) where

import           Control.Monad (mzero)
import           Control.Monad.Identity
import           Control.Monad.State
import           Control.Monad.Trans.Maybe
import           Control.Monad.Writer
import           Problems.Monads           (Element (..), Operator (..))

{- | Use monad transformers to evaluate postfix notation.

Returns @Nothing@ when there is an error.  Also returns the history of the evaluation.
-}
calculatePostfix :: [Element] -> (Maybe Integer, [([Integer], Maybe Operator)])
calculatePostfix :: [Element] -> (Maybe Integer, [(Stack, Maybe Operator)])
calculatePostfix [Element]
xs = ((Maybe (), Stack) -> Maybe Integer
forall {a}. (Maybe (), [a]) -> Maybe a
extract (Maybe (), Stack)
result, [(Stack, Maybe Operator)]
calculations)
  where ((Maybe (), Stack)
result, [(Stack, Maybe Operator)]
calculations) = MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
-> ((Maybe (), Stack), [(Stack, Maybe Operator)])
forall {a} {w} {a}.
MaybeT (StateT [a] (WriterT w Identity)) a -> ((Maybe a, [a]), w)
run (MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
 -> ((Maybe (), Stack), [(Stack, Maybe Operator)]))
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
-> ((Maybe (), Stack), [(Stack, Maybe Operator)])
forall a b. (a -> b) -> a -> b
$ [Element]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculatePostfix' [Element]
xs
        run :: MaybeT (StateT [a] (WriterT w Identity)) a -> ((Maybe a, [a]), w)
run MaybeT (StateT [a] (WriterT w Identity)) a
f = Identity ((Maybe a, [a]), w) -> ((Maybe a, [a]), w)
forall a. Identity a -> a
runIdentity (Identity ((Maybe a, [a]), w) -> ((Maybe a, [a]), w))
-> Identity ((Maybe a, [a]), w) -> ((Maybe a, [a]), w)
forall a b. (a -> b) -> a -> b
$ WriterT w Identity (Maybe a, [a]) -> Identity ((Maybe a, [a]), w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w Identity (Maybe a, [a]) -> Identity ((Maybe a, [a]), w))
-> WriterT w Identity (Maybe a, [a])
-> Identity ((Maybe a, [a]), w)
forall a b. (a -> b) -> a -> b
$ StateT [a] (WriterT w Identity) (Maybe a)
-> [a] -> WriterT w Identity (Maybe a, [a])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MaybeT (StateT [a] (WriterT w Identity)) a
-> StateT [a] (WriterT w Identity) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (StateT [a] (WriterT w Identity)) a
f) []
        extract :: (Maybe (), [a]) -> Maybe a
extract (Maybe ()
Nothing, [a]
_)   = Maybe a
forall a. Maybe a
Nothing
        extract (Just (), [a
x]) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
        extract (Maybe (), [a])
_              = Maybe a
forall a. Maybe a
Nothing

type Stack = [Integer]

type Calculation = MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)]))

calculatePostfix' :: [Element] -> Calculation ()
calculatePostfix' :: [Element]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculatePostfix' (Operand Integer
n : [Element]
xs) = do
  Integer
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
push Integer
n
  Stack
stack <- MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) Stack
forall s (m :: * -> *). MonadState s m => m s
get
  [(Stack, Maybe Operator)]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Stack
stack, Maybe Operator
forall a. Maybe a
Nothing)]
  [Element]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculatePostfix' [Element]
xs
calculatePostfix' (Operator Operator
op : [Element]
xs) = do
  Operator
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculate Operator
op
  Stack
stack <- MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) Stack
forall s (m :: * -> *). MonadState s m => m s
get
  [(Stack, Maybe Operator)]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Stack
stack, Operator -> Maybe Operator
forall a. a -> Maybe a
Just Operator
op)]
  [Element]
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculatePostfix' [Element]
xs
calculatePostfix' [] = () -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

calculate :: Operator -> Calculation ()
calculate :: Operator
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
calculate Operator
Negate = do
  Integer
n <- Calculation Integer
pop
  Integer
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
push (Integer
 -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ())
-> Integer
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall a b. (a -> b) -> a -> b
$ -Integer
n
calculate Operator
op = do
  Integer
b <- Calculation Integer
pop
  Integer
a <- Calculation Integer
pop
  Integer
n <- Operator -> Integer -> Integer -> Calculation Integer
binaryOp Operator
op Integer
a Integer
b
  Integer
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
push Integer
n

binaryOp :: Operator -> Integer -> Integer -> Calculation Integer
binaryOp :: Operator -> Integer -> Integer -> Calculation Integer
binaryOp Operator
Add Integer
a Integer
b      = Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Calculation Integer) -> Integer -> Calculation Integer
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
b
binaryOp Operator
Subtract Integer
a Integer
b = Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Calculation Integer) -> Integer -> Calculation Integer
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
b
binaryOp Operator
Multiply Integer
a Integer
b = Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Calculation Integer) -> Integer -> Calculation Integer
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b
binaryOp Operator
Divide Integer
_ Integer
0   = Calculation Integer
forall a.
MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
binaryOp Operator
Divide Integer
a Integer
b   = Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Calculation Integer) -> Integer -> Calculation Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
b
binaryOp Operator
Modulo Integer
_ Integer
0   = Calculation Integer
forall a.
MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
binaryOp Operator
Modulo Integer
a Integer
b   = Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Calculation Integer) -> Integer -> Calculation Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
b
binaryOp Operator
_ Integer
_ Integer
_        = Calculation Integer
forall a.
MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

push :: Integer -> Calculation ()
push :: Integer
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
push Integer
x = (Stack -> Stack)
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Integer
x:)

pop :: Calculation Integer
pop :: Calculation Integer
pop = do
  Stack
xs <- MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) Stack
forall s (m :: * -> *). MonadState s m => m s
get
  case Stack
xs of
    [] -> Calculation Integer
forall a.
MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    (Integer
x:Stack
xs') -> do
      Stack
-> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Stack
xs'
      Integer -> Calculation Integer
forall a.
a -> MaybeT (StateT Stack (Writer [(Stack, Maybe Operator)])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
x