{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Roboservant.Types.Internal where

import qualified Data.Dependent.Map as DM
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.Dynamic (Dynamic, toDyn)
import Data.Hashable (Hashable, hash)
import Data.IntSet (IntSet)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import qualified Type.Reflection as R

data Provenance
  = Provenance R.SomeTypeRep Int
  deriving (Int -> Provenance -> ShowS
[Provenance] -> ShowS
Provenance -> String
(Int -> Provenance -> ShowS)
-> (Provenance -> String)
-> ([Provenance] -> ShowS)
-> Show Provenance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Provenance -> ShowS
showsPrec :: Int -> Provenance -> ShowS
$cshow :: Provenance -> String
show :: Provenance -> String
$cshowList :: [Provenance] -> ShowS
showList :: [Provenance] -> ShowS
Show, Provenance -> Provenance -> Bool
(Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool) -> Eq Provenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
/= :: Provenance -> Provenance -> Bool
Eq, (forall x. Provenance -> Rep Provenance x)
-> (forall x. Rep Provenance x -> Provenance) -> Generic Provenance
forall x. Rep Provenance x -> Provenance
forall x. Provenance -> Rep Provenance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Provenance -> Rep Provenance x
from :: forall x. Provenance -> Rep Provenance x
$cto :: forall x. Rep Provenance x -> Provenance
to :: forall x. Rep Provenance x -> Provenance
Generic)

instance Hashable Provenance

data StashValue a
  = StashValue
      { forall a. StashValue a -> NonEmpty ([Provenance], a)
getStashValue :: NonEmpty ([Provenance], a),
        forall a. StashValue a -> IntSet
stashHash :: IntSet
      }
  deriving ((forall a b. (a -> b) -> StashValue a -> StashValue b)
-> (forall a b. a -> StashValue b -> StashValue a)
-> Functor StashValue
forall a b. a -> StashValue b -> StashValue a
forall a b. (a -> b) -> StashValue a -> StashValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> StashValue a -> StashValue b
fmap :: forall a b. (a -> b) -> StashValue a -> StashValue b
$c<$ :: forall a b. a -> StashValue b -> StashValue a
<$ :: forall a b. a -> StashValue b -> StashValue a
Functor, Int -> StashValue a -> ShowS
[StashValue a] -> ShowS
StashValue a -> String
(Int -> StashValue a -> ShowS)
-> (StashValue a -> String)
-> ([StashValue a] -> ShowS)
-> Show (StashValue a)
forall a. Show a => Int -> StashValue a -> ShowS
forall a. Show a => [StashValue a] -> ShowS
forall a. Show a => StashValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> StashValue a -> ShowS
showsPrec :: Int -> StashValue a -> ShowS
$cshow :: forall a. Show a => StashValue a -> String
show :: StashValue a -> String
$cshowList :: forall a. Show a => [StashValue a] -> ShowS
showList :: [StashValue a] -> ShowS
Show)

-- wrap in newtype to give a custom Show instance, since the normal
-- instance for DMap is not happy since StashValue needs Show a to show
newtype Stash = Stash {Stash -> DMap TypeRep StashValue
getStash :: DMap R.TypeRep StashValue}
  deriving (NonEmpty Stash -> Stash
Stash -> Stash -> Stash
(Stash -> Stash -> Stash)
-> (NonEmpty Stash -> Stash)
-> (forall b. Integral b => b -> Stash -> Stash)
-> Semigroup Stash
forall b. Integral b => b -> Stash -> Stash
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Stash -> Stash -> Stash
<> :: Stash -> Stash -> Stash
$csconcat :: NonEmpty Stash -> Stash
sconcat :: NonEmpty Stash -> Stash
$cstimes :: forall b. Integral b => b -> Stash -> Stash
stimes :: forall b. Integral b => b -> Stash -> Stash
Semigroup, Semigroup Stash
Stash
Semigroup Stash =>
Stash
-> (Stash -> Stash -> Stash) -> ([Stash] -> Stash) -> Monoid Stash
[Stash] -> Stash
Stash -> Stash -> Stash
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Stash
mempty :: Stash
$cmappend :: Stash -> Stash -> Stash
mappend :: Stash -> Stash -> Stash
$cmconcat :: [Stash] -> Stash
mconcat :: [Stash] -> Stash
Monoid)

instance Show Stash where
  showsPrec :: Int -> Stash -> ShowS
showsPrec Int
i (Stash DMap TypeRep StashValue
x) =
    Int -> Map SomeTypeRep (NonEmpty [Provenance]) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i
      (Map SomeTypeRep (NonEmpty [Provenance]) -> ShowS)
-> Map SomeTypeRep (NonEmpty [Provenance]) -> ShowS
forall a b. (a -> b) -> a -> b
$ [(SomeTypeRep, NonEmpty [Provenance])]
-> Map SomeTypeRep (NonEmpty [Provenance])
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SomeTypeRep, NonEmpty [Provenance])]
 -> Map SomeTypeRep (NonEmpty [Provenance]))
-> ([DSum TypeRep StashValue]
    -> [(SomeTypeRep, NonEmpty [Provenance])])
-> [DSum TypeRep StashValue]
-> Map SomeTypeRep (NonEmpty [Provenance])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DSum TypeRep StashValue -> (SomeTypeRep, NonEmpty [Provenance]))
-> [DSum TypeRep StashValue]
-> [(SomeTypeRep, NonEmpty [Provenance])]
forall a b. (a -> b) -> [a] -> [b]
map (\(TypeRep a
tr :=> StashValue NonEmpty ([Provenance], a)
vs IntSet
_) -> (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
tr, (([Provenance], a) -> [Provenance])
-> NonEmpty ([Provenance], a) -> NonEmpty [Provenance]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Provenance], a) -> [Provenance]
forall a b. (a, b) -> a
fst NonEmpty ([Provenance], a)
vs))
      ([DSum TypeRep StashValue]
 -> Map SomeTypeRep (NonEmpty [Provenance]))
-> [DSum TypeRep StashValue]
-> Map SomeTypeRep (NonEmpty [Provenance])
forall a b. (a -> b) -> a -> b
$ DMap TypeRep StashValue -> [DSum TypeRep StashValue]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DM.toList DMap TypeRep StashValue
x

-- | Can't be built up from parts, can't be broken down further.
newtype Atom x = Atom {forall x. Atom x -> x
unAtom :: x}
  deriving newtype (Eq (Atom x)
Eq (Atom x) =>
(Int -> Atom x -> Int) -> (Atom x -> Int) -> Hashable (Atom x)
Int -> Atom x -> Int
Atom x -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall x. Hashable x => Eq (Atom x)
forall x. Hashable x => Int -> Atom x -> Int
forall x. Hashable x => Atom x -> Int
$chashWithSalt :: forall x. Hashable x => Int -> Atom x -> Int
hashWithSalt :: Int -> Atom x -> Int
$chash :: forall x. Hashable x => Atom x -> Int
hash :: Atom x -> Int
Hashable, Typeable,Atom x -> Atom x -> Bool
(Atom x -> Atom x -> Bool)
-> (Atom x -> Atom x -> Bool) -> Eq (Atom x)
forall x. Eq x => Atom x -> Atom x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall x. Eq x => Atom x -> Atom x -> Bool
== :: Atom x -> Atom x -> Bool
$c/= :: forall x. Eq x => Atom x -> Atom x -> Bool
/= :: Atom x -> Atom x -> Bool
Eq)

-- | can be broken down and built up from generic pieces
newtype Compound x = Compound {forall x. Compound x -> x
unCompound :: x}
  deriving newtype (Eq (Compound x)
Eq (Compound x) =>
(Int -> Compound x -> Int)
-> (Compound x -> Int) -> Hashable (Compound x)
Int -> Compound x -> Int
Compound x -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall x. Hashable x => Eq (Compound x)
forall x. Hashable x => Int -> Compound x -> Int
forall x. Hashable x => Compound x -> Int
$chashWithSalt :: forall x. Hashable x => Int -> Compound x -> Int
hashWithSalt :: Int -> Compound x -> Int
$chash :: forall x. Hashable x => Compound x -> Int
hash :: Compound x -> Int
Hashable, Typeable, Compound x -> Compound x -> Bool
(Compound x -> Compound x -> Bool)
-> (Compound x -> Compound x -> Bool) -> Eq (Compound x)
forall x. Eq x => Compound x -> Compound x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall x. Eq x => Compound x -> Compound x -> Bool
== :: Compound x -> Compound x -> Bool
$c/= :: forall x. Eq x => Compound x -> Compound x -> Bool
/= :: Compound x -> Compound x -> Bool
Eq)

hashedDyn :: (Hashable a, Typeable a) => a -> (Dynamic, Int)
hashedDyn :: forall a. (Hashable a, Typeable a) => a -> (Dynamic, Int)
hashedDyn a
a = (a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
a, a -> Int
forall a. Hashable a => a -> Int
hash a
a)