Привет лор! решаю тут задачку про отмеривание определенного количества жидкости с помощью дух сосудов разных объемов.
Хочу замутить решение на монадах, заюзал для этого RWS монаду ибо на ней по сути можно писать любой конечный автомат с выводом любой фигни являющейся моноидом.
Вот быдлокод того что уже есть
module Main where
import Control.Monad.Trans.RWS
import Control.Monad.RWS.Class
import Data.Monoid
import Control.Arrow ((&&&))
data Bottle a = Bottle {getSize :: a,
getMax :: a} deriving Show
getFree :: (Num a) => Bottle a -> a
getFree b = (getMax b) - (getSize b)
emptyBottle :: (Num a) => Bottle a -> Bottle a
emptyBottle (Bottle {getSize = _, getMax = m}) = Bottle {getSize = 0, getMax = m}
fillBottle :: (Ord a, Num a) => a -> Bottle a -> Bottle a
fillBottle am (Bottle {getSize = s, getMax = m}) = Bottle {getSize = max 0 $ min m $ am + s, getMax = m}
data Action a = Flow {getFrom :: Bottle a,
getTo :: Bottle a,
getAmount :: a}
| Fill {getWhat :: Bottle a,
getAmount :: a}
| Empty {getWhat :: Bottle a,
getAmount :: a} deriving Show
type SolveMonad m a ret = RWST () (Endo [Action a]) (Bottle a, Bottle a) m ret
endotell :: (Monad m) => [Action a] -> SolveMonad m a ()
endotell a = tell $ Endo $ (++ a)
leftToRight, rightToLeft :: (Monad m, Num a, Ord a) => SolveMonad m a ()
leftToRight = do
(l, r) <- get
if (getFree r) >= (getSize l)
then do endotell [(Flow {getFrom = l, getTo = r, getAmount = (getSize l)})]
put (emptyBottle l, fillBottle (getSize l) r)
else do endotell [(Flow {getFrom = l, getTo = r, getAmount = (getFree r)})]
put (fillBottle (negate $ getFree r) l, fillBottle (getSize l) r)
execSwapped :: (Monad m) => SolveMonad m a () -> SolveMonad m a ()
execSwapped mex = do
modify (snd &&& fst)
mex
modify (snd &&& fst)
rightToLeft = execSwapped leftToRight
fillLeft, fillRight :: (Monad m, Num a, Ord a) => SolveMonad m a ()
fillLeft = do
(l, r) <- get
put (fillBottle (getFree l) l, r)
fillRight = execSwapped fillLeft
emptyLeft, emptyRight :: (Monad m, Num a) => SolveMonad m a ()
emptyLeft = do
(l, r) <- get
put (emptyBottle l, r)
emptyRight = execSwapped emptyLeft
Собственно тут описаны только действия которые можно совершать на емкостями, перелить из одной в другую пока в одной не кончится либо другая не наполниться, опустошить либо наполнить одну из бутылок.
Хочу теперь монаду, которая похожа на RWS но совершает действия НАД моей RWS, то есть чтобы оператор >>= в этой монаде выполнял дополнительную проверку на то, что в одном из сосудов нужное нам количество жидкости (то есть проверял состояние) и останавливал вычисление как нибудь, то есть хочу вот такое
magic :: SomeMagicType
magic = do
lift fillLeft
lift leftToRight
(l, r) <- get
if (isFull r) then do
lift emptyRight
else return () -- ну как то так, типа то еще не знаю точного
magic
а потом вычислять это нечто как то вот так
(runMagic magic) (\(l, r) -> r == 3 || l == 3)
и получить свою RWS монаду в которую потом подставить окружение и состоятие, но как такое сделать ? Готовую монаду проверки состояния не нагуглил чето. Или может это инчаче делается ?
