{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}

{-|
Module      : Headroom.Data.Has
Description : Simplified variant of @Data.Has@
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module provides 'Has' /type class/, adapted to the needs of this
application.
-}

module Headroom.Data.Has
  ( Has(..)
  )
where

import           RIO

-- | Implementation of the /Has type class/ pattern.
class Has a t where
  {-# MINIMAL getter, modifier | hasLens #-}
  getter :: t -> a
  getter = Const a t -> a
forall a k (b :: k). Const a b -> a
getConst (Const a t -> a) -> (t -> Const a t) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> t -> Const a t
forall a t. Has a t => Lens' t a
hasLens a -> Const a a
forall k a (b :: k). a -> Const a b
Const

  modifier :: (a -> a) -> t -> t
  modifier a -> a
f t
t = Identity t -> t
forall a. Identity a -> a
runIdentity ((a -> Identity a) -> t -> Identity t
forall a t. Has a t => Lens' t a
hasLens (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (a -> a) -> a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) t
t)

  hasLens :: Lens' t a
  hasLens a -> f a
afa t
t = (\a
a -> (a -> a) -> t -> t
forall a t. Has a t => (a -> a) -> t -> t
modifier (a -> a -> a
forall a b. a -> b -> a
const a
a) t
t) (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afa (t -> a
forall a t. Has a t => t -> a
getter t
t)

  viewL :: MonadReader t m => m a
  viewL = ((a -> Const a a) -> t -> Const a t) -> m a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (a -> Const a a) -> t -> Const a t
forall a t. Has a t => Lens' t a
hasLens