{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Downhill.Internal.Graph.NodeMap
(
NodeMap,
NodeKey,
fromOpenMap,
generate,
lookup,
tryLookup,
toList,
toListWith,
elems,
map,
mapWithKey,
adjust,
zipWith,
IsNodeSet,
SomeNodeMap (..),
KeyAndValue (..),
)
where
import Control.Applicative (Const)
import Data.Data (Proxy (Proxy))
import Data.Reflection (Reifies (reflect), reify)
import Downhill.Internal.Graph.OpenMap (OpenKey, OpenMap, SomeOpenItem (SomeOpenItem))
import qualified Downhill.Internal.Graph.OpenMap as OpenMap
import Prelude (Maybe (Just, Nothing), const, error, (.), (<$>))
type role NodeKey nominal nominal
newtype NodeKey s x = NodeKey (OpenKey x)
newtype NodeMap s f = NodeMap {forall s (f :: * -> *). NodeMap s f -> OpenMap f
unNodeMap :: OpenMap f}
data KeyAndValue s f = forall x. KeyAndValue (NodeKey s x) (f x)
class IsNodeSet s where
allNodes :: OpenMap Proxy
map :: forall s f g. (forall v. f v -> g v) -> NodeMap s f -> NodeMap s g
map :: forall s (f :: * -> *) (g :: * -> *).
(forall v. f v -> g v) -> NodeMap s f -> NodeMap s g
map forall v. f v -> g v
f = forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x) -> OpenMap f -> OpenMap g
OpenMap.map forall v. f v -> g v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (f :: * -> *). NodeMap s f -> OpenMap f
unNodeMap
mapWithKey :: forall s f g. (forall x. NodeKey s x -> f x -> g x) -> NodeMap s f -> NodeMap s g
mapWithKey :: forall s (f :: * -> *) (g :: * -> *).
(forall x. NodeKey s x -> f x -> g x) -> NodeMap s f -> NodeMap s g
mapWithKey forall x. NodeKey s x -> f x -> g x
f (NodeMap OpenMap f
x) = forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap (forall (f :: * -> *) (g :: * -> *).
(forall d. OpenKey d -> f d -> g d) -> OpenMap f -> OpenMap g
OpenMap.mapWithKey forall dx. OpenKey dx -> f dx -> g dx
f' OpenMap f
x)
where
f' :: OpenKey dx -> f dx -> g dx
f' :: forall dx. OpenKey dx -> f dx -> g dx
f' OpenKey dx
key' = forall x. NodeKey s x -> f x -> g x
f (forall s x. OpenKey x -> NodeKey s x
NodeKey OpenKey dx
key')
toList :: NodeMap s f -> [KeyAndValue s f]
toList :: forall s (f :: * -> *). NodeMap s f -> [KeyAndValue s f]
toList = forall s (f :: * -> *) r.
(forall x. NodeKey s x -> f x -> r) -> NodeMap s f -> [r]
toListWith forall s (f :: * -> *) x. NodeKey s x -> f x -> KeyAndValue s f
KeyAndValue
toListWith :: forall s f r. (forall x. NodeKey s x -> f x -> r) -> NodeMap s f -> [r]
toListWith :: forall s (f :: * -> *) r.
(forall x. NodeKey s x -> f x -> r) -> NodeMap s f -> [r]
toListWith forall x. NodeKey s x -> f x -> r
f (NodeMap OpenMap f
m) = SomeOpenItem f -> r
wrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). OpenMap f -> [SomeOpenItem f]
OpenMap.toList OpenMap f
m
where
wrap :: SomeOpenItem f -> r
wrap :: SomeOpenItem f -> r
wrap (SomeOpenItem OpenKey x
key f x
value) = forall x. NodeKey s x -> f x -> r
f (forall s x. OpenKey x -> NodeKey s x
NodeKey OpenKey x
key) f x
value
elems :: NodeMap s (Const b) -> [b]
elems :: forall s b. NodeMap s (Const b) -> [b]
elems (NodeMap OpenMap (Const b)
m) = forall b. OpenMap (Const b) -> [b]
OpenMap.elems OpenMap (Const b)
m
lookup :: NodeMap s f -> NodeKey s v -> f v
lookup :: forall s (f :: * -> *) v. NodeMap s f -> NodeKey s v -> f v
lookup (NodeMap OpenMap f
m) (NodeKey OpenKey v
key) =
case forall (f :: * -> *) x. OpenMap f -> OpenKey x -> Maybe (f x)
OpenMap.lookup OpenMap f
m OpenKey v
key of
Just f v
x -> f v
x
Maybe (f v)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"oh fuck"
tryLookup :: NodeMap s f -> OpenKey x -> Maybe (NodeKey s x, f x)
tryLookup :: forall s (f :: * -> *) x.
NodeMap s f -> OpenKey x -> Maybe (NodeKey s x, f x)
tryLookup (NodeMap OpenMap f
m) OpenKey x
key =
case forall (f :: * -> *) x. OpenMap f -> OpenKey x -> Maybe (f x)
OpenMap.lookup OpenMap f
m OpenKey x
key of
Just f x
x -> forall a. a -> Maybe a
Just (forall s x. OpenKey x -> NodeKey s x
NodeKey OpenKey x
key, f x
x)
Maybe (f x)
Nothing -> forall a. Maybe a
Nothing
generate :: forall s f. IsNodeSet s => (forall x. NodeKey s x -> f x) -> NodeMap s f
generate :: forall s (f :: * -> *).
IsNodeSet s =>
(forall x. NodeKey s x -> f x) -> NodeMap s f
generate forall x. NodeKey s x -> f x
f = case forall s. IsNodeSet s => OpenMap Proxy
allNodes @s of
OpenMap Proxy
m -> forall s (f :: * -> *) (g :: * -> *).
(forall x. NodeKey s x -> f x -> g x) -> NodeMap s f -> NodeMap s g
mapWithKey (\NodeKey s x
key Proxy x
_ -> forall x. NodeKey s x -> f x
f NodeKey s x
key) (forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap OpenMap Proxy
m)
zipWith :: forall s f g h. (forall x. f x -> g x -> h x) -> NodeMap s f -> NodeMap s g -> NodeMap s h
zipWith :: forall s (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall x. f x -> g x -> h x)
-> NodeMap s f -> NodeMap s g -> NodeMap s h
zipWith forall x. f x -> g x -> h x
f (NodeMap OpenMap f
x) (NodeMap OpenMap g
y) = forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap (forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(forall x. f x -> g x -> h x)
-> OpenMap f -> OpenMap g -> OpenMap h
OpenMap.intersectionWith forall x. f x -> g x -> h x
f OpenMap f
x OpenMap g
y)
adjust :: forall s f x. (f x -> f x) -> NodeKey s x -> NodeMap s f -> NodeMap s f
adjust :: forall s (f :: * -> *) x.
(f x -> f x) -> NodeKey s x -> NodeMap s f -> NodeMap s f
adjust f x -> f x
f (NodeKey OpenKey x
key) (NodeMap OpenMap f
m) = forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap (forall (f :: * -> *) x.
(f x -> f x) -> OpenKey x -> OpenMap f -> OpenMap f
OpenMap.adjust f x -> f x
f OpenKey x
key OpenMap f
m)
data NodeSetWrapper s
instance Reifies s (OpenMap Proxy) => IsNodeSet (NodeSetWrapper s) where
allNodes :: OpenMap Proxy
allNodes = forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect @s forall {k} (t :: k). Proxy t
Proxy
data SomeNodeMap f where
SomeNodeMap :: IsNodeSet s => NodeMap s f -> SomeNodeMap f
fromOpenMap :: forall f. OpenMap f -> SomeNodeMap f
fromOpenMap :: forall (f :: * -> *). OpenMap f -> SomeNodeMap f
fromOpenMap OpenMap f
x = forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify OpenMap Proxy
nodes forall s. Reifies s (OpenMap Proxy) => Proxy s -> SomeNodeMap f
go
where
nodes :: OpenMap Proxy
nodes :: OpenMap Proxy
nodes = forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x) -> OpenMap f -> OpenMap g
OpenMap.map (forall a b. a -> b -> a
const forall {k} (t :: k). Proxy t
Proxy) OpenMap f
x
go :: forall s. Reifies s (OpenMap Proxy) => Proxy s -> SomeNodeMap f
go :: forall s. Reifies s (OpenMap Proxy) => Proxy s -> SomeNodeMap f
go Proxy s
_proxy = forall s (f :: * -> *). IsNodeSet s => NodeMap s f -> SomeNodeMap f
SomeNodeMap @(NodeSetWrapper s) (forall s (f :: * -> *). OpenMap f -> NodeMap s f
NodeMap OpenMap f
x)