-
Notifications
You must be signed in to change notification settings - Fork 0
/
NodeKey.purs
185 lines (113 loc) · 5.54 KB
/
NodeKey.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
module Blessed.Internal.NodeKey where
import Prelude
import Prim.Symbol (class Append) as S
import Data.Enum (class Enum)
import Data.Newtype (class Newtype)
import Data.Symbol (class IsSymbol, reflectSymbol, reifySymbol)
import Data.Maybe (Maybe(..))
import Type.Proxy (Proxy(..))
import Data.Tuple (curry, uncurry)
import Data.Tuple.Nested ((/\), type (/\))
import Unsafe.Coerce (unsafeCoerce)
import Data.Unfoldable1 (class Unfoldable1)
import Data.Unfoldable1.Extra (iterateN)
import Data.Argonaut.Encode (class EncodeJson)
import Blessed.Internal.BlessedSubj as K
data NodeKey (kind :: K.Subject) (symbol :: Symbol) = NodeKey (Maybe Int)
newtype RawNodeKey = RawNodeKey { subject :: K.Subject_, id :: String } -- FIXME: include index separately, not in `id`
derive instance Newtype RawNodeKey _
derive newtype instance EncodeJson RawNodeKey
-- private
raw :: K.Subject_ -> String -> RawNodeKey
raw subject id = RawNodeKey { subject, id }
infixl 6 make as <^>
infixl 6 type NodeKey as <^>
make :: forall subj sym. K.IsSubject subj => IsSymbol sym => Proxy subj -> Proxy sym -> NodeKey subj sym
make _ _ = NodeKey Nothing
makeN :: forall subj sym. K.IsSubject subj => IsSymbol sym => Proxy subj -> (Proxy sym /\ Int) -> NodeKey subj sym
makeN _ ( _ /\ n) = NodeKey $ Just n
nk :: forall subj sym. NodeKey subj sym
nk = NodeKey Nothing
first :: forall subj sym. NodeKey subj sym
first = NodeKey $ Just 0
next :: forall subj sym. NodeKey subj sym -> NodeKey subj sym
next (NodeKey maybeN) = NodeKey $ nextN maybeN
where
nextN (Just n) = if n < top then Just $ n + 1 else Nothing
nextN Nothing = Just bottom
prev :: forall subj sym. NodeKey subj sym -> NodeKey subj sym
prev (NodeKey maybeN) = NodeKey $ prevN maybeN
where
prevN (Just n) = if n > bottom then Just $ n - 1 else Nothing
prevN Nothing = Just top
-- private
setN :: forall subj sym. Int -> NodeKey subj sym -> NodeKey subj sym
setN n _ = NodeKey $ Just n
getN :: forall subj sym. NodeKey subj sym -> Maybe Int
getN (NodeKey maybeN) = maybeN
append :: forall subjA symA subjB symB symC. S.Append symA symB symC => NodeKey subjA symA -> NodeKey subjB symB -> NodeKey subjB symC
append (NodeKey (Just nA)) (NodeKey (Just nB)) = nk # setN (nA * 1000 + nB)
append (NodeKey Nothing) (NodeKey (Just nB)) = nk # setN nB
append (NodeKey (Just nA)) (NodeKey Nothing) = nk # setN (nA * 1000)
append (NodeKey Nothing) (NodeKey Nothing) = nk
makeUnsafe :: forall subj sym. IsSymbol sym => K.IsSubject subj => Proxy subj -> String -> NodeKey subj sym
makeUnsafe subj s = unsafeCoerce $ reifySymbol s \sym -> unsafeCoerce $ make subj sym
rawify :: forall subj sym. K.IsSubject subj => IsSymbol sym => NodeKey subj sym -> RawNodeKey
rawify = uncurry raw <<< rawify'
rawify' :: forall subj sym. K.IsSubject subj => IsSymbol sym => NodeKey subj sym -> K.Subject_ /\ String
rawify' nodeKey = getSubject nodeKey /\ getId nodeKey
process :: K.Ext K.Process <^> ""
process = NodeKey Nothing
toString :: forall subj sym. K.IsSubject subj => IsSymbol sym => NodeKey subj sym -> String
toString nodeKey =
case rawify' nodeKey of
subj /\ id -> id <> ":" <> K.toString subj
-- reflectSymbol (Proxy :: _ sym) <> ":" <> K.toString (K.reflectSubject (Proxy :: _ subj))
getId :: forall subj sym. IsSymbol sym => NodeKey subj sym -> String
getId (NodeKey maybeN) = reflectSymbol (Proxy :: _ sym) <> "__" <> rawNPostfix maybeN
where
rawNPostfix (Just n) = show n
rawNPostfix Nothing = ""
getSubject :: forall subj sym. K.IsSubject subj => IsSymbol sym => NodeKey subj sym -> K.Subject_
getSubject _ = K.reflectSubject (Proxy :: _ subj)
instance Ord (NodeKey subj sym) where
compare (NodeKey mbA) (NodeKey mbB) = compare mbA mbB
instance Bounded (NodeKey subj sym) where
top = NodeKey $ Just top
bottom = NodeKey $ Just bottom
instance Enum (NodeKey subj sym) where
succ prevNk =
let nextNk = next prevNk
in case nextNk of
NodeKey (Just _) -> Just nextNk
NodeKey Nothing -> Nothing
pred nextNk =
let prevNk = prev nextNk
in case prevNk of
NodeKey (Just _) -> Just prevNk
NodeKey Nothing -> Nothing
chain :: forall f subj id. Unfoldable1 f => Int -> f (NodeKey subj id)
chain = iterateN next first
continue :: forall f subjA subjB idA idB. Unfoldable1 f => NodeKey subjA idA -> Int -> f (NodeKey subjB idB)
continue (NodeKey (Just n)) = iterateN next $ NodeKey $ Just n
continue (NodeKey Nothing) = iterateN next first
nestChain :: forall f subjA subjB idA idB. Unfoldable1 f => NodeKey subjA idA -> Int -> f (NodeKey subjB idB)
nestChain (NodeKey (Just n)) = iterateN next $ NodeKey $ Just $ n * 1000
nestChain (NodeKey Nothing) = iterateN next first
-- FIXME: `Belongs`?
class (K.Extends parent subj, K.IsSubject parent, K.IsSubject subj, IsSymbol id) <= Respresents parent subj id
instance (K.Extends parent subj, K.IsSubject parent, K.IsSubject subj, IsSymbol id) => Respresents parent subj id
instance Eq (NodeKey subj id) where
eq (NodeKey nA) (NodeKey nB) = nA == nB
instance (K.IsSubject subj, IsSymbol id) => Show (NodeKey subj id) where
show = toString
instance Eq RawNodeKey where
eq (RawNodeKey nkA) (RawNodeKey nkB) =
(K.toString nkA.subject == K.toString nkB.subject)
&& (nkA.id == nkB.id)
instance Ord RawNodeKey where
compare (RawNodeKey nkA) (RawNodeKey nkB) =
compare (K.toString nkA.subject) (K.toString nkB.subject) <> compare nkA.id nkB.id
instance Show RawNodeKey where
show (RawNodeKey nk) =
K.toString nk.subject <> ":" <> nk.id