{-# 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.Undirected.AdjacencyMap as Bipartite
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
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)
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
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_)
data DepGraph = DepGraph
{ DepGraph -> HashSet SomeDepRep
provided :: HashSet SomeDepRep,
DepGraph -> HashSet SomeDepRep
required :: HashSet SomeDepRep,
DepGraph -> Graph SomeDepRep
depToDep :: Graph SomeDepRep,
DepGraph -> AdjacencyMap SomeDepRep SomeMonadConstraintRep
depToMonad :: Bipartite.AdjacencyMap SomeDepRep SomeMonadConstraintRep
}
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