{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Dep.Dynamic.Internal where

import Dep.Env
import Dep.Has
import Control.Applicative
import Control.Exception
import Data.Coerce
import Data.Function (fix)
import Data.Functor (($>), (<&>))
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Identity
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as H
import Data.Kind
import Data.Proxy
import Data.String
import Data.Type.Equality (type (==))
import Data.Typeable
import GHC.Generics qualified as G
import GHC.Records
import GHC.TypeLits
import Type.Reflection qualified as R
import Data.Hashable
import Algebra.Graph 
import qualified Algebra.Graph.Bipartite.AdjacencyMap as Bipartite


-- | The type rep of a constraint over a monad. Similar to 'Type.Reflection.SomeTypeRep' 
-- but for types of a more specific kind.
data SomeMonadConstraintRep where
  SomeMonadConstraintRep :: forall (a :: (Type -> Type) -> Constraint). !(R.TypeRep a) -> SomeMonadConstraintRep

instance Eq SomeMonadConstraintRep where
    SomeMonadConstraintRep TypeRep a
r1 == :: SomeMonadConstraintRep -> SomeMonadConstraintRep -> Bool
== SomeMonadConstraintRep TypeRep a
r2 = forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 forall a. Eq a => a -> a -> Bool
== forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r2

instance Ord SomeMonadConstraintRep where
    SomeMonadConstraintRep TypeRep a
r1 compare :: SomeMonadConstraintRep -> SomeMonadConstraintRep -> Ordering
`compare` SomeMonadConstraintRep TypeRep a
r2 = forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 forall a. Ord a => a -> a -> Ordering
`compare` forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r2

instance Hashable SomeMonadConstraintRep where
  hashWithSalt :: Int -> SomeMonadConstraintRep -> Int
hashWithSalt Int
salt (SomeMonadConstraintRep TypeRep a
tr) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep a
tr
  hash :: SomeMonadConstraintRep -> Int
hash (SomeMonadConstraintRep TypeRep a
tr) = forall a. Hashable a => a -> Int
hash TypeRep a
tr

instance Show SomeMonadConstraintRep where
    show :: SomeMonadConstraintRep -> String
show (SomeMonadConstraintRep TypeRep a
r1) = forall a. Show a => a -> String
show TypeRep a
r1

-- | Produce a 'SomeMonadConstraintRep' by means of a type application.
monadConstraintRep :: forall (mc :: (Type -> Type) -> Constraint) . R.Typeable mc => SomeMonadConstraintRep
monadConstraintRep :: forall (mc :: (* -> *) -> Constraint).
Typeable mc =>
SomeMonadConstraintRep
monadConstraintRep = forall (a :: (* -> *) -> Constraint).
TypeRep a -> SomeMonadConstraintRep
SomeMonadConstraintRep (forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @mc)

type MonadSatisfiesAll :: [(Type -> Type) -> Constraint] -> (Type -> Type) -> Constraint
type family MonadSatisfiesAll cs m where
  MonadSatisfiesAll '[] m = ()
  MonadSatisfiesAll (c : cs) m = (c m, MonadSatisfiesAll cs m)

-- | The type rep of a parameterizable record type. Similar to 'Type.Reflection.SomeTypeRep' 
-- but for types of a more specific kind.
data SomeDepRep where
    SomeDepRep :: forall (a :: (Type -> Type) -> Type) . !(R.TypeRep a) -> SomeDepRep

instance Eq SomeDepRep where
    SomeDepRep TypeRep a
r1 == :: SomeDepRep -> SomeDepRep -> Bool
== SomeDepRep TypeRep a
r2 = forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 forall a. Eq a => a -> a -> Bool
== forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r2

instance Ord SomeDepRep where
    SomeDepRep TypeRep a
r1 compare :: SomeDepRep -> SomeDepRep -> Ordering
`compare` SomeDepRep TypeRep a
r2 = forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 forall a. Ord a => a -> a -> Ordering
`compare` forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r2

instance Hashable SomeDepRep where
    hashWithSalt :: Int -> SomeDepRep -> Int
hashWithSalt Int
salt (SomeDepRep TypeRep a
tr) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep a
tr
    hash :: SomeDepRep -> Int
hash (SomeDepRep TypeRep a
tr) = forall a. Hashable a => a -> Int
hash TypeRep a
tr 

instance Show SomeDepRep where
    show :: SomeDepRep -> String
show (SomeDepRep TypeRep a
r1) = forall a. Show a => a -> String
show TypeRep a
r1

-- | Produce a 'SomeDepRep' by means of a type application.
depRep :: forall (r_ :: (Type -> Type) -> Type) . R.Typeable r_ => SomeDepRep
depRep :: forall (r_ :: (* -> *) -> *). Typeable r_ => SomeDepRep
depRep = forall (a :: (* -> *) -> *). TypeRep a -> SomeDepRep
SomeDepRep (forall {k} (a :: k). Typeable a => TypeRep a
R.typeRep @r_)




-- | A summary graph of dependencies.  
-- If the required dependencies are not a subset of the provided ones, the environment is not yet complete.
--
-- The graph datatypes come from the [algebraic-graphs](https://hackage.haskell.org/package/algebraic-graphs) package.
data DepGraph = DepGraph
  { DepGraph -> HashSet SomeDepRep
provided :: HashSet SomeDepRep, -- ^ components that have been inserted in the environment
    DepGraph -> HashSet SomeDepRep
required :: HashSet SomeDepRep, -- ^ components that are required by other components in the environment
    DepGraph -> Graph SomeDepRep
depToDep :: Graph SomeDepRep, -- ^ graph with dependencies components have on other components
    DepGraph -> AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad :: Bipartite.AdjacencyMap SomeDepRep SomeMonadConstraintRep -- ^ bipartite graph with the constraints components require from the effect monad
  }

instance Semigroup DepGraph where 
  DepGraph {provided :: DepGraph -> HashSet SomeDepRep
provided = HashSet SomeDepRep
provided1, required :: DepGraph -> HashSet SomeDepRep
required = HashSet SomeDepRep
required1, depToDep :: DepGraph -> Graph SomeDepRep
depToDep = Graph SomeDepRep
depToDep1, depToMonad :: DepGraph -> AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad = AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad1}
   <> :: DepGraph -> DepGraph -> DepGraph
<> DepGraph {provided :: DepGraph -> HashSet SomeDepRep
provided = HashSet SomeDepRep
provided2, required :: DepGraph -> HashSet SomeDepRep
required = HashSet SomeDepRep
required2, depToDep :: DepGraph -> Graph SomeDepRep
depToDep = Graph SomeDepRep
depToDep2, depToMonad :: DepGraph -> AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad = AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad2} =
     DepGraph { provided :: HashSet SomeDepRep
provided = HashSet SomeDepRep
provided1 forall a. Semigroup a => a -> a -> a
<> HashSet SomeDepRep
provided2
      , required :: HashSet SomeDepRep
required = HashSet SomeDepRep
required1 forall a. Semigroup a => a -> a -> a
<> HashSet SomeDepRep
required2
      , depToDep :: Graph SomeDepRep
depToDep = forall a. Graph a -> Graph a -> Graph a
overlay Graph SomeDepRep
depToDep1 Graph SomeDepRep
depToDep2
      , depToMonad :: AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad = forall a b.
(Ord a, Ord b) =>
AdjacencyMap a b -> AdjacencyMap a b -> AdjacencyMap a b
Bipartite.overlay AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad1 AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad2
     }

instance Monoid DepGraph where
  mempty :: DepGraph
mempty = HashSet SomeDepRep
-> HashSet SomeDepRep
-> Graph SomeDepRep
-> AdjacencyMap SomeDepRep SomeMonadConstraintRep
-> DepGraph
DepGraph forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Graph a
Algebra.Graph.empty forall a b. AdjacencyMap a b
Bipartite.empty


-- $setup
--
-- >>> :set -XTypeApplications
-- >>> :set -XMultiParamTypeClasses
-- >>> :set -XImportQualifiedPost
-- >>> :set -XStandaloneKindSignatures
-- >>> :set -XNamedFieldPuns
-- >>> :set -XFunctionalDependencies
-- >>> :set -XFlexibleContexts
-- >>> :set -XDataKinds
-- >>> :set -XBlockArguments
-- >>> :set -XFlexibleInstances
-- >>> :set -XTypeFamilies
-- >>> :set -XDeriveGeneric
-- >>> :set -XViewPatterns
-- >>> :set -XScopedTypeVariables
-- >>> import Data.Kind
-- >>> import Control.Monad.Dep
-- >>> import Data.Function
-- >>> import GHC.Generics (Generic)
-- >>> import Dep.Has
-- >>> import Dep.Env
-- >>> import Dep.Dynamic
-- >>> import Dep.Advice (component, runFromDep)