module Halogen.Data.Slot where

import Data.Map.Strict qualified as M
import Data.Row
import Data.Set qualified as S
import GHC.TypeLits (sameSymbol)
import HPrelude

data VoidF p

data Slot (query :: Type -> Type) (output :: Type) (slotType :: Type)

-- some element of the `slots` row type, ordered by label and slot Ord instance
data SlotElem (slots :: Row Type) (slot :: (Type -> Type) -> Type -> Type) where
  SlotElem
    :: (HasType sym' (Slot query output s) slots', KnownSymbol sym', Ord s)
    => Proxy sym'
    -> s
    -> ~(slot query output)
    -> SlotElem slots' slot

instance Eq (SlotElem slots' slot) where
  SlotElem Proxy sym'
p s
s slot query output
_ == :: SlotElem slots' slot -> SlotElem slots' slot -> Bool
== SlotElem Proxy sym'
p' s
s' slot query output
_ =
    Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== do
      Refl <- Proxy sym' -> Proxy sym' -> Maybe (sym' :~: sym')
forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
       (proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol Proxy sym'
p Proxy sym'
p'
      pure $ s == s'

instance Ord (SlotElem slots' slot) where
  SlotElem Proxy sym'
p s
s slot query output
_ compare :: SlotElem slots' slot -> SlotElem slots' slot -> Ordering
`compare` SlotElem Proxy sym'
p' s
s' slot query output
_ =
    case Proxy sym' -> Proxy sym' -> Maybe (sym' :~: sym')
forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
       (proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol Proxy sym'
p Proxy sym'
p' of
      Just sym' :~: sym'
Refl -> s
s s -> s -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` s
s
s'
      Maybe (sym' :~: sym')
Nothing -> Proxy sym' -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym'
p String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Proxy sym' -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym'
p'

newtype SlotStorage slots slot = SlotStorage (Set (SlotElem slots slot))

lookup
  :: forall symb
    ->( HasType symb (Slot query output s) slots'
      , KnownSymbol symb
      , Ord s
      )
  => s
  -> SlotStorage slots' slot
  -> Maybe (slot query output)
lookup :: forall (query :: * -> *) output s (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s -> SlotStorage slots' slot -> Maybe (slot query output)
lookup symb s
key (SlotStorage Set (SlotElem slots' slot)
s) = do
  SlotElem sym' key' slot <- SlotElem slots' slot
-> Set (SlotElem slots' slot) -> Maybe (SlotElem slots' slot)
forall a. Ord a => a -> Set a -> Maybe a
S.lookupGE (Proxy symb -> s -> slot query output -> SlotElem slots' slot
forall (sym' :: Symbol) (query :: * -> *) output s
       (slots' :: Row (*)) (slot :: (* -> *) -> * -> *).
(HasType sym' (Slot query output s) slots', KnownSymbol sym',
 Ord s) =>
Proxy sym' -> s -> slot query output -> SlotElem slots' slot
SlotElem (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @symb) s
key ((slot query output -> slot query output) -> slot query output
forall a. (a -> a) -> a
fix slot query output -> slot query output
forall a. a -> a
identity)) Set (SlotElem slots' slot)
s
  Refl <- sameSymbol (Proxy @symb) sym'
  guard (key == key')
  pure slot

empty :: SlotStorage slots' slot
empty :: forall (slots' :: Row (*)) (slot :: (* -> *) -> * -> *).
SlotStorage slots' slot
empty = Set (SlotElem slots' slot) -> SlotStorage slots' slot
forall (slots :: Row (*)) (slot :: (* -> *) -> * -> *).
Set (SlotElem slots slot) -> SlotStorage slots slot
SlotStorage Set (SlotElem slots' slot)
forall a. Set a
S.empty

pop
  :: forall symb
    ->( HasType symb (Slot query output s) slots'
      , KnownSymbol symb
      , Ord s
      )
  => s
  -> SlotStorage slots' slot
  -> Maybe (slot query output, SlotStorage slots' slot)
pop :: forall (query :: * -> *) output s (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s
-> SlotStorage slots' slot
-> Maybe (slot query output, SlotStorage slots' slot)
pop symb s
key stor :: SlotStorage slots' slot
stor@(SlotStorage Set (SlotElem slots' slot)
s) = do
  slot <- s -> SlotStorage slots' slot -> Maybe (slot query output)
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s -> SlotStorage slots' slot -> Maybe (slot query output)
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s -> SlotStorage slots' slot -> Maybe (slot query output)
forall (query :: * -> *) output s (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s -> SlotStorage slots' slot -> Maybe (slot query output)
lookup symb s
key SlotStorage slots' slot
stor
  pure (slot, SlotStorage $ S.delete (SlotElem (Proxy @symb) key slot) s)

insert
  :: forall symb
    ->( HasType symb (Slot query output s) slots'
      , KnownSymbol symb
      , Ord s
      )
  => s
  -> slot query output
  -> SlotStorage slots' slot
  -> SlotStorage slots' slot
insert :: forall (query :: * -> *) output s (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
s
-> slot query output
-> SlotStorage slots' slot
-> SlotStorage slots' slot
insert symb s
key slot query output
slot = (Set (SlotElem slots' slot) -> Set (SlotElem slots' slot))
-> SlotStorage slots' slot -> SlotStorage slots' slot
forall a b. Coercible a b => a -> b
coerce (SlotElem slots' slot
-> Set (SlotElem slots' slot) -> Set (SlotElem slots' slot)
forall a. Ord a => a -> Set a -> Set a
S.insert (Proxy symb -> s -> slot query output -> SlotElem slots' slot
forall (sym' :: Symbol) (query :: * -> *) output s
       (slots' :: Row (*)) (slot :: (* -> *) -> * -> *).
(HasType sym' (Slot query output s) slots', KnownSymbol sym',
 Ord s) =>
Proxy sym' -> s -> slot query output -> SlotElem slots' slot
SlotElem (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @symb) s
key slot query output
slot))

slots
  :: forall symb
    ->( HasType symb (Slot query output s) slots'
      , KnownSymbol symb
      , Ord s
      )
  => SlotStorage slots' slot
  -> Map s (slot query output)
slots :: forall (query :: * -> *) output s (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
forall (symb :: Symbol) ->
(HasType symb (Slot query output s) slots', KnownSymbol symb,
 Ord s) =>
SlotStorage slots' slot -> Map s (slot query output)
slots symb (SlotStorage Set (SlotElem slots' slot)
s) =
  [(s, slot query output)] -> Map s (slot query output)
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([(s, slot query output)] -> Map s (slot query output))
-> [(s, slot query output)] -> Map s (slot query output)
forall a b. (a -> b) -> a -> b
$ (SlotElem slots' slot -> Maybe (s, slot query output))
-> [SlotElem slots' slot] -> [(s, slot query output)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SlotElem slots' slot -> Maybe (s, slot query output)
flt ([SlotElem slots' slot] -> [(s, slot query output)])
-> [SlotElem slots' slot] -> [(s, slot query output)]
forall a b. (a -> b) -> a -> b
$ Set (SlotElem slots' slot) -> [SlotElem slots' slot]
forall a. Set a -> [a]
S.toAscList Set (SlotElem slots' slot)
s
  where
    flt :: SlotElem slots' slot -> Maybe (s, slot query output)
flt (SlotElem Proxy sym'
symb' s
key' slot query output
slot) = do
      Refl <- Proxy symb -> Proxy sym' -> Maybe (symb :~: sym')
forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
       (proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @symb) Proxy sym'
symb'
      pure (key', slot)

foreachSlot
  :: (Applicative m)
  => SlotStorage slots' slot
  -> (forall query output. slot query output -> m ())
  -> m ()
foreachSlot :: forall (m :: * -> *) (slots' :: Row (*))
       (slot :: (* -> *) -> * -> *).
Applicative m =>
SlotStorage slots' slot
-> (forall (query :: * -> *) output. slot query output -> m ())
-> m ()
foreachSlot (SlotStorage Set (SlotElem slots' slot)
s) forall (query :: * -> *) output. slot query output -> m ()
act =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ @_ @_ @_ @() Set (SlotElem slots' slot)
s ((SlotElem slots' slot -> m ()) -> m ())
-> (SlotElem slots' slot -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(SlotElem Proxy sym'
_ s
_ slot query output
v) -> slot query output -> m ()
forall (query :: * -> *) output. slot query output -> m ()
act slot query output
v -- TODO no idea why I need to type apply