{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provenance] -> ShowS
$cshowList :: [Provenance] -> ShowS
show :: Provenance -> String
$cshow :: Provenance -> String
showsPrec :: Int -> Provenance -> ShowS
$cshowsPrec :: Int -> Provenance -> ShowS
Show, Provenance -> Provenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c== :: Provenance -> Provenance -> Bool
Eq, 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
$cto :: forall x. Rep Provenance x -> Provenance
$cfrom :: forall x. Provenance -> Rep Provenance x
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 -> 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
<$ :: forall a b. a -> StashValue b -> StashValue a
$c<$ :: forall a b. a -> StashValue b -> StashValue a
fmap :: forall a b. (a -> b) -> StashValue a -> StashValue b
$cfmap :: forall a b. (a -> b) -> StashValue a -> StashValue b
Functor, Int -> StashValue a -> ShowS
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
showList :: [StashValue a] -> ShowS
$cshowList :: forall a. Show a => [StashValue a] -> ShowS
show :: StashValue a -> String
$cshow :: forall a. Show a => StashValue a -> String
showsPrec :: Int -> StashValue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
forall b. Integral b => b -> Stash -> Stash
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Stash -> Stash
$cstimes :: forall b. Integral b => b -> Stash -> Stash
sconcat :: NonEmpty Stash -> Stash
$csconcat :: NonEmpty Stash -> Stash
<> :: Stash -> Stash -> Stash
$c<> :: Stash -> Stash -> Stash
Semigroup, Semigroup Stash
Stash
[Stash] -> Stash
Stash -> Stash -> Stash
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Stash] -> Stash
$cmconcat :: [Stash] -> Stash
mappend :: Stash -> Stash -> Stash
$cmappend :: Stash -> Stash -> Stash
mempty :: Stash
$cmempty :: Stash
Monoid)

instance Show Stash where
  showsPrec :: Int -> Stash -> ShowS
showsPrec Int
i (Stash DMap TypeRep StashValue
x) =
    forall a. Show a => Int -> a -> ShowS
showsPrec Int
i
      forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(TypeRep a
tr :=> StashValue NonEmpty ([Provenance], a)
vs IntSet
_) -> (forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
tr, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty ([Provenance], a)
vs))
      forall a b. (a -> b) -> a -> b
$ 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 (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
hash :: Atom x -> Int
$chash :: forall x. Hashable x => Atom x -> Int
hashWithSalt :: Int -> Atom x -> Int
$chashWithSalt :: forall x. Hashable x => Int -> Atom x -> Int
Hashable, Typeable,Atom x -> Atom x -> Bool
forall x. Eq x => Atom x -> Atom x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom x -> Atom x -> Bool
$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
Eq)

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

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