{-# 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.Except.CoHas
( CoHas(..)
, SuccessfulSearch
, module X
, throwError
, liftEither
, liftMaybe
) where
import qualified Control.Monad.Except as M
import Control.Monad.Except as X hiding(throwError, liftEither)
import Data.Bifunctor
import Data.Kind
import Data.Proxy
import GHC.Generics
import Data.Path
type family Search option (g :: k -> Type) :: MaybePath where
Search option (K1 _ option) = 'Found 'Here
Search option (K1 _ other) = 'NotFound
Search option (M1 _ _ x) = Search option x
Search option (f :+: g) = Combine (Search option f) (Search option g)
Search _ _ = 'NotFound
class GCoHas (path :: Path) option gsum where
ginject :: Proxy path -> option -> gsum p
instance GCoHas 'Here rec (K1 i rec) where
ginject :: forall (p :: k). Proxy 'Here -> rec -> K1 i rec p
ginject Proxy 'Here
_ = forall k i c (p :: k). c -> K1 i c p
K1
instance GCoHas path option sum => GCoHas path option (M1 i t sum) where
ginject :: forall (p :: k). Proxy path -> option -> M1 i t sum p
ginject Proxy path
proxy = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (path :: Path) option (gsum :: k -> *) (p :: k).
GCoHas path option gsum =>
Proxy path -> option -> gsum p
ginject Proxy path
proxy
instance GCoHas path option l => GCoHas ('L path) option (l :+: r) where
ginject :: forall (p :: k). Proxy ('L path) -> option -> (:+:) l r p
ginject Proxy ('L path)
_ = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (path :: Path) option (gsum :: k -> *) (p :: k).
GCoHas path option gsum =>
Proxy path -> option -> gsum p
ginject (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)
instance GCoHas path option r => GCoHas ('R path) option (l :+: r) where
ginject :: forall (p :: k). Proxy ('R path) -> option -> (:+:) l r p
ginject Proxy ('R path)
_ = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (path :: Path) option (gsum :: k -> *) (p :: k).
GCoHas path option gsum =>
Proxy path -> option -> gsum p
ginject (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)
type SuccessfulSearch option sum path = (Search option (Rep sum) ~ 'Found path, GCoHas path option (Rep sum))
class CoHas option sum where
inject :: option -> sum
default inject :: forall path. (Generic sum, SuccessfulSearch option sum path) => option -> sum
inject = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (path :: Path) option (gsum :: k -> *) (p :: k).
GCoHas path option gsum =>
Proxy path -> option -> gsum p
ginject (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)
instance CoHas sum sum where
inject :: sum -> sum
inject = forall sum. sum -> sum
id
instance SuccessfulSearch a (Either l r) path => CoHas a (Either l r)
throwError :: (MonadError error m, CoHas option error) => option -> m a
throwError :: forall error (m :: * -> *) option a.
(MonadError error m, CoHas option error) =>
option -> m a
throwError = forall e (m :: * -> *) a. MonadError e m => e -> m a
M.throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall option sum. CoHas option sum => option -> sum
inject
liftEither :: (MonadError error m, CoHas option error) => Either option a -> m a
liftEither :: forall error (m :: * -> *) option a.
(MonadError error m, CoHas option error) =>
Either option a -> m a
liftEither = forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
M.liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall option sum. CoHas option sum => option -> sum
inject
liftMaybe :: (MonadError error m, CoHas option error) => option -> Maybe a -> m a
liftMaybe :: forall error (m :: * -> *) option a.
(MonadError error m, CoHas option error) =>
option -> Maybe a -> m a
liftMaybe option
_ (Just a
val) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
liftMaybe option
err Maybe a
Nothing = forall error (m :: * -> *) option a.
(MonadError error m, CoHas option error) =>
option -> m a
throwError option
err