Prism.hs

{-# LANGUAGE RankNTypes #-}

module MacSdk.Prism where

import Data.Functor.Identity (Identity(..))
import Data.Profunctor.Choice (Choice(..))
import Control.Monad.Error.Class (MonadError(..))
import Data.Tagged

type Prism' s a =
  forall p f. (Choice p, Applicative f) => p a (f a) -> p s (f s)

type AReview t b = Tagged b (Identity b) -> Tagged t (Identity t)

review :: AReview t b -> b -> t
review r = runIdentity . unTagged . r . Tagged . Identity

throwing :: MonadError t m => Prism' t e -> e -> m a
throwing p e = throwError (review p e)