quox/lib/Control/Monad/ST/Extra.idr

65 lines
1.4 KiB
Idris
Raw Normal View History

2023-09-18 18:41:47 -04:00
module Control.Monad.ST.Extra
import public Control.Monad.ST
import Data.IORef
import Control.MonadRec
%default total
export %inline
MonadRec (ST s) where
tailRecM seed (Access rec) st f = MkST $ do
let MkST io = f seed st
case !io of
Done res => pure res
Cont seed2 prf vst =>
let MkST io = tailRecM seed2 (rec seed2 prf) vst f in io
public export
interface HasST (0 m : Type -> Type -> Type) where
liftST : ST s a -> m s a
export %inline HasST ST where liftST = id
public export
record STErr e s a where
constructor STE
fromSTErr : ST s (Either e a)
export
Functor (STErr e s) where
map f (STE e) = STE $ map f <$> e
export
Applicative (STErr e s) where
pure x = STE $ pure $ pure x
STE f <*> STE x = STE [|f <*> x|]
export
Monad (STErr e s) where
STE m >>= k = STE $ do
case !m of
Left err => pure $ Left err
Right x => fromSTErr $ k x
export
MonadRec (STErr e s) where
tailRecM s (Access r) x k = STE $ do
let STE m = k s x
case !m of
Left err => pure $ Left err
Right (Cont s' p y) => fromSTErr $ tailRecM s' (r s' p) y k
Right (Done y) => pure $ Right y
export
runSTErr : (forall s. STErr e s a) -> Either e a
runSTErr ste = runST $ fromSTErr ste
export %inline HasST (STErr e) where liftST = STE . map Right
export
stLeft : e -> STErr e s a
stLeft e = STE $ pure $ Left e