{-# 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 = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 SomeTypeRep -> SomeTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep a -> SomeTypeRep
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 = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` TypeRep a -> SomeTypeRep
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) = Int -> TypeRep a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep a
tr
  hash :: SomeMonadConstraintRep -> Int
hash (SomeMonadConstraintRep TypeRep a
tr) = TypeRep a -> Int
forall a. Hashable a => a -> Int
hash TypeRep a
tr

instance Show SomeMonadConstraintRep where
    show :: SomeMonadConstraintRep -> String
show (SomeMonadConstraintRep TypeRep a
r1) = TypeRep a -> String
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 :: SomeMonadConstraintRep
monadConstraintRep = TypeRep mc -> SomeMonadConstraintRep
forall (a :: (* -> *) -> Constraint).
TypeRep a -> SomeMonadConstraintRep
SomeMonadConstraintRep (Typeable mc => TypeRep mc
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 = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 SomeTypeRep -> SomeTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep a -> SomeTypeRep
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 = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
r1 SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` TypeRep a -> SomeTypeRep
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) = Int -> TypeRep a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt TypeRep a
tr
    hash :: SomeDepRep -> Int
hash (SomeDepRep TypeRep a
tr) = TypeRep a -> Int
forall a. Hashable a => a -> Int
hash TypeRep a
tr 

instance Show SomeDepRep where
    show :: SomeDepRep -> String
show (SomeDepRep TypeRep a
r1) = TypeRep a -> String
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 :: SomeDepRep
depRep = TypeRep r_ -> SomeDepRep
forall (a :: (* -> *) -> *). TypeRep a -> SomeDepRep
SomeDepRep (Typeable r_ => TypeRep r_
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 :: HashSet SomeDepRep
-> HashSet SomeDepRep
-> Graph SomeDepRep
-> AdjacencyMap SomeDepRep SomeMonadConstraintRep
-> DepGraph
DepGraph { provided :: HashSet SomeDepRep
provided = HashSet SomeDepRep
provided1 HashSet SomeDepRep -> HashSet SomeDepRep -> HashSet SomeDepRep
forall a. Semigroup a => a -> a -> a
<> HashSet SomeDepRep
provided2
      , required :: HashSet SomeDepRep
required = HashSet SomeDepRep
required1 HashSet SomeDepRep -> HashSet SomeDepRep -> HashSet SomeDepRep
forall a. Semigroup a => a -> a -> a
<> HashSet SomeDepRep
required2
      , depToDep :: Graph SomeDepRep
depToDep = Graph SomeDepRep -> Graph SomeDepRep -> Graph SomeDepRep
forall a. Graph a -> Graph a -> Graph a
overlay Graph SomeDepRep
depToDep1 Graph SomeDepRep
depToDep2
      , depToMonad :: AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad = AdjacencyMap SomeDepRep SomeMonadConstraintRep
-> AdjacencyMap SomeDepRep SomeMonadConstraintRep
-> AdjacencyMap SomeDepRep SomeMonadConstraintRep
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 HashSet SomeDepRep
forall a. Monoid a => a
mempty HashSet SomeDepRep
forall a. Monoid a => a
mempty Graph SomeDepRep
forall a. Graph a
Algebra.Graph.empty AdjacencyMap SomeDepRep SomeMonadConstraintRep
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)