{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}

-- | This module provides a generic \"Has\" class favoring a style in which the

-- components of the environment come wrapped in records or newtypes, instead

-- of being bare functions.

--

-- >>> :{

--  type Logger :: (Type -> Type) -> Type

--  newtype Logger d = Logger {log :: String -> d ()} deriving Generic

--  instance Dep Logger where

--    type DefaultFieldName Logger = "logger"

--  data Repository d = Repository

--    { select :: String -> d [Int],

--      insert :: [Int] -> d ()

--    } deriving Generic

--  instance Dep Repository where

--    type DefaultFieldName Repository = "repository"

--  newtype Controller d = Controller {serve :: Int -> d String} deriving Generic

--  instance Dep Controller where

--    type DefaultFieldName Controller = "controller"

--  type Env :: (Type -> Type) -> Type

--  data Env m = Env

--    { logger :: Logger m,

--      repository :: Repository m,

--      controller :: Controller m

--    }

--  instance Has Logger m (Env m)

--  instance Has Repository m (Env m)

--  instance Has Controller m (Env m)

--  mkController :: forall d e m. MonadDep [Has Logger, Has Repository] d e m => Controller m

--  mkController =

--    Controller \url -> do

--      e <- ask

--      liftD $ log (dep e) "I'm going to insert in the db!"

--      liftD $ select (dep e) "select * from ..."

--      liftD $ insert (dep e) [1, 2, 3, 4]

--      return "view"

-- :}

--

-- The @adviseRecord@ and @deceiveRecord@ functions from the companion package

-- \"dep-t-advice\" can facilitate working with this style of components.

--

module Control.Monad.Dep.Has (
        -- * A generic \"Has\"

        Has (..), 
        -- * Component defaults

        Dep (..)
    ) where

import Data.Kind
import GHC.Records
import GHC.TypeLits
import Data.Coerce

-- $setup

--

-- >>> :set -XTypeApplications

-- >>> :set -XMultiParamTypeClasses

-- >>> :set -XImportQualifiedPost

-- >>> :set -XTemplateHaskell

-- >>> :set -XStandaloneKindSignatures

-- >>> :set -XNamedFieldPuns

-- >>> :set -XFunctionalDependencies

-- >>> :set -XFlexibleContexts

-- >>> :set -XDataKinds

-- >>> :set -XRankNTypes

-- >>> :set -XBlockArguments

-- >>> :set -XFlexibleInstances

-- >>> :set -XTypeFamilies

-- >>> :set -XDeriveGeneric

-- >>> import Control.Monad.Dep

-- >>> import Rank2 qualified

-- >>> import Rank2.TH qualified

-- >>> import GHC.Generics (Generic)

--



-- | A generic \"Has\" class. When partially applied to a parametrizable

-- record-of-functions @r_@, produces a 2-place constraint that can be later

-- used with "Control.Monad.Dep.Class".

type Has :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint
class Has r_ d e | e -> d where
  -- |  Given an environment @e@, produce a record-of-functions parameterized by the environment's effect monad @d@.

  --

  -- The hope is that using a selector function on the resulting record will

  -- determine its type without the need for type annotations.

  --

  -- (This will likely not play well with RecordDotSyntax. See also <https://chrisdone.com/posts/import-aliases-field-names/ this trick>.)

  dep :: e -> r_ d
  default dep :: (Dep r_, HasField (DefaultFieldName r_) e u, Coercible u (r_ d)) => e -> r_ d
  dep e
e = u -> r_ d
coerce (u -> r_ d) -> (e -> u) -> e -> r_ d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField (DefaultFieldName r_) r a => r -> a
getField @(DefaultFieldName r_) (e -> r_ d) -> e -> r_ d
forall a b. (a -> b) -> a -> b
$ e
e

-- | Parametrizable records-of-functions can be given an instance of this

-- typeclass to specify the default field name 'Has' expects for the component

-- in the environment record.

--

-- This allows defining 'Has' instances with empty bodies, thanks to

-- @DefaultSignatures@.

type Dep :: ((Type -> Type) -> Type) -> Constraint
class Dep r_ where
  -- The Char kind would be useful here, to lowercase the first letter of the

  -- k type and use it as the default preferred field name.

  type DefaultFieldName r_ :: Symbol

-- -- Doesn't make much sense to have this, we already have Has!

-- type Sub :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> Constraint

-- class Sub sub super

-- type SubWrapper :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type

-- data SubWrapper sub super d e = SubWrapper e


-- type Nested :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type

-- data Nested sub super d e = Nested e

-- 

-- instance (Has sub d e, Has super d (sub d)) => Has super d (Nested sub super d e) where

--     dep (Nested e) = dep @super (dep @sub e)


-- Possible example

-- instance Has ReadRef IO (Env IO) via (Nested Ref ReadRef IO (Env IO))