module Control.Lens.Getter where
import Control.Monad.State.Class
import Control.Monad.Reader.Class
import Control.Applicative
import Unsafe.Coerce
import Data.Monoid
import Data.Foldable
infixl 8 ^.
type Getting r s a = (a -> Accessor r a) -> s -> Accessor r s
type Getter s a = forall r. Getting r s a
folded :: (Foldable f, Monoid r) => Getting r (f a) a
folded ar = unsafeCoerce `asTypeOf` (Accessor .)
$ foldMap (unsafeCoerce `asTypeOf` (runAccessor .) $ ar)
views :: MonadReader s m => Getting r s a -> (a -> r) -> m r
views = asks unsafeCoerce
view :: MonadReader s m => Getting a s a -> m a
view l = views l id
foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf = unsafeCoerce
foldOf :: Getting a s a -> s -> a
foldOf l = foldMapOf l id
to :: (s -> a) -> Getter s a
to f = \ar -> unsafeCoerce (ar . f)
(^.) :: s -> Getting a s a -> a
(^.) = flip foldOf
uses :: MonadState s m => Getter s a -> (a -> r) -> m r
uses g f = get >>= foldMapOf g (return . f)
use :: MonadState s m => Getter s a -> m a
use g = uses g id
newtype Accessor r a = Accessor { runAccessor :: r }
deriving (Show, Read, Eq, Ord, Functor)
instance Monoid r => Applicative (Accessor r) where
pure _ = Accessor mempty
Accessor a <*> Accessor b = Accessor (mappend a b)