{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Reader.Has
( Has(..)
, SuccessfulSearch
, module X
, ask
, asks
, reader
) where
import qualified Control.Monad.Reader as M
import Control.Monad.Reader as X hiding(ask, asks, reader)
import Data.Kind
import Data.Proxy
import GHC.Generics
import Data.Path
type family Search part (g :: k -> Type) :: MaybePath where
Search part (K1 _ part) = 'Found 'Here
Search part (K1 _ other) = 'NotFound
Search part (M1 _ _ x) = Search part x
Search part (f :*: g) = Combine (Search part f) (Search part g)
Search _ _ = 'NotFound
class GHas (path :: Path) part grecord where
:: Proxy path -> grecord p -> part
gupdate :: Proxy path -> (part -> part) -> grecord p -> grecord p
instance GHas 'Here rec (K1 i rec) where
gextract :: forall (p :: k). Proxy 'Here -> K1 i rec p -> rec
gextract Proxy 'Here
_ (K1 rec
x) = rec
x
gupdate :: forall (p :: k).
Proxy 'Here -> (rec -> rec) -> K1 i rec p -> K1 i rec p
gupdate Proxy 'Here
_ rec -> rec
f (K1 rec
x) = forall k i c (p :: k). c -> K1 i c p
K1 forall a b. (a -> b) -> a -> b
$ rec -> rec
f rec
x
instance GHas path part record => GHas path part (M1 i t record) where
gextract :: forall (p :: k). Proxy path -> M1 i t record p -> part
gextract Proxy path
proxy (M1 record p
x) = forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> grecord p -> part
gextract Proxy path
proxy record p
x
gupdate :: forall (p :: k).
Proxy path -> (part -> part) -> M1 i t record p -> M1 i t record p
gupdate Proxy path
proxy part -> part
f (M1 record p
x) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> (part -> part) -> grecord p -> grecord p
gupdate Proxy path
proxy part -> part
f record p
x)
instance GHas path part l => GHas ('L path) part (l :*: r) where
gextract :: forall (p :: k). Proxy ('L path) -> (:*:) l r p -> part
gextract Proxy ('L path)
_ (l p
l :*: r p
_) = forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> grecord p -> part
gextract (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) l p
l
gupdate :: forall (p :: k).
Proxy ('L path) -> (part -> part) -> (:*:) l r p -> (:*:) l r p
gupdate Proxy ('L path)
_ part -> part
f (l p
l :*: r p
r) = forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> (part -> part) -> grecord p -> grecord p
gupdate (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) part -> part
f l p
l forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: r p
r
instance GHas path part r => GHas ('R path) part (l :*: r) where
gextract :: forall (p :: k). Proxy ('R path) -> (:*:) l r p -> part
gextract Proxy ('R path)
_ (l p
_ :*: r p
r) = forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> grecord p -> part
gextract (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) r p
r
gupdate :: forall (p :: k).
Proxy ('R path) -> (part -> part) -> (:*:) l r p -> (:*:) l r p
gupdate Proxy ('R path)
_ part -> part
f (l p
l :*: r p
r) = l p
l forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> (part -> part) -> grecord p -> grecord p
gupdate (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) part -> part
f r p
r
type SuccessfulSearch part record path = (Search part (Rep record) ~ 'Found path, GHas path part (Rep record))
class Has part record where
:: record -> part
default :: forall path. (Generic record, SuccessfulSearch part record path) => record -> part
extract = forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> grecord p -> part
gextract (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
update :: (part -> part) -> record -> record
default update :: forall path. (Generic record, SuccessfulSearch part record path) => (part -> part) -> record -> record
update part -> part
f = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (path :: Path) part (grecord :: k -> *) (p :: k).
GHas path part grecord =>
Proxy path -> (part -> part) -> grecord p -> grecord p
gupdate (forall {k} (t :: k). Proxy t
Proxy :: Proxy path) part -> part
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
instance Has record record where
extract :: record -> record
extract = forall record. record -> record
id
update :: (record -> record) -> record -> record
update = forall record. record -> record
id
instance SuccessfulSearch a (a0, a1) path => Has a (a0, a1)
instance SuccessfulSearch a (a0, a1, a2) path => Has a (a0, a1, a2)
instance SuccessfulSearch a (a0, a1, a2, a3) path => Has a (a0, a1, a2, a3)
instance SuccessfulSearch a (a0, a1, a2, a3, a4) path => Has a (a0, a1, a2, a3, a4)
instance SuccessfulSearch a (a0, a1, a2, a3, a4, a5) path => Has a (a0, a1, a2, a3, a4, a5)
ask :: (MonadReader record m, Has part record) => m part
ask :: forall record (m :: * -> *) part.
(MonadReader record m, Has part record) =>
m part
ask = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
M.asks forall part record. Has part record => record -> part
extract
asks :: (MonadReader record m, Has part record) => (part -> a) -> m a
asks :: forall record (m :: * -> *) part a.
(MonadReader record m, Has part record) =>
(part -> a) -> m a
asks part -> a
f = part -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record (m :: * -> *) part.
(MonadReader record m, Has part record) =>
m part
ask
reader :: (MonadReader record m, Has part record) => (part -> a) -> m a
reader :: forall record (m :: * -> *) part a.
(MonadReader record m, Has part record) =>
(part -> a) -> m a
reader = forall record (m :: * -> *) part a.
(MonadReader record m, Has part record) =>
(part -> a) -> m a
asks