🍴 Meu Garfo é uma visualização em grafo dos CNPJs
cuducos.tngl.io/meu-garfo
1module View exposing (view)
2
3import Dict exposing (Dict)
4import Format
5import Html exposing (Html, a, abbr, button, details, div, em, footer, h1, header, input, label, li, main_, nav, small, span, summary, text, ul)
6import Html.Attributes exposing (attribute, class, for, href, id, placeholder, type_, value)
7import Html.Events exposing (custom, onClick, onInput, preventDefaultOn)
8import Json.Decode as Decode
9import Set exposing (Set)
10import Svg exposing (Svg, circle, g, line, svg, text_)
11import Svg.Attributes as SA
12import Svg.Events as SE
13import Types exposing (..)
14
15
16view : Model -> Html Msg
17view model =
18 let
19 nodeList =
20 Dict.values model.nodes
21
22 companiesCount =
23 List.filter
24 (\n ->
25 case n.entity of
26 Company _ _ _ ->
27 True
28
29 _ ->
30 False
31 )
32 nodeList
33 |> List.length
34
35 peopleCount =
36 List.filter
37 (\n ->
38 case n.entity of
39 Person _ _ ->
40 True
41
42 _ ->
43 False
44 )
45 nodeList
46 |> List.length
47 in
48 div [ class "app-root" ]
49 [ header [ class "app-header" ]
50 [ nav []
51 [ ul []
52 [ li [] [ h1 [] [ text "Meu Garfo" ] ]
53 , li []
54 [ a
55 [ href "#"
56 , preventDefaultOnClick (SwitchTab CnpjTab)
57 , class
58 (if model.activeTab == CnpjTab then
59 ""
60
61 else
62 "secondary"
63 )
64 , attribute "style"
65 (if model.activeTab == CnpjTab then
66 "font-weight: bold; border-bottom: 2px solid var(--pico-primary); border-radius: 0;"
67
68 else
69 ""
70 )
71 ]
72 [ text "CNPJ" ]
73 ]
74 , li []
75 [ a
76 [ href "#"
77 , preventDefaultOnClick (SwitchTab ConnectionTab)
78 , class
79 (if model.activeTab == ConnectionTab then
80 ""
81
82 else
83 "secondary"
84 )
85 , attribute "style"
86 (if model.activeTab == ConnectionTab then
87 "font-weight: bold; border-bottom: 2px solid var(--pico-primary); border-radius: 0;"
88
89 else
90 ""
91 )
92 ]
93 [ text "Conexões" ]
94 ]
95 ]
96 , ul [ class "controls" ]
97 (case model.activeTab of
98 CnpjTab ->
99 [ li []
100 [ label [ for "cnpj-input" ] [ text "CNPJ" ]
101 , input
102 [ id "cnpj-input"
103 , class "cnpj-input"
104 , placeholder "00.000.000/0000-00"
105 , value model.input
106 , onInput UpdateInput
107 , onEnter Search
108 , attribute "aria-label" "CNPJ"
109 ]
110 []
111 ]
112 , li []
113 [ button
114 [ onClick Search
115 , Html.Attributes.disabled (not (Set.isEmpty model.pending))
116 , class "primary"
117 ]
118 [ text
119 (if not (Set.isEmpty model.pending) then
120 "Carregando..."
121
122 else
123 "Buscar"
124 )
125 ]
126 ]
127 , clearButton model
128 ]
129
130 ConnectionTab ->
131 [ li []
132 [ label [ for "connection-input-1" ] [ text "Origem" ]
133 , input
134 [ id "connection-input-1"
135 , class "cnpj-input"
136 , placeholder "CNPJ ou ID"
137 , value model.connectionInput1
138 , onInput UpdateConnectionInput1
139 , onEnter Search
140 , attribute "aria-label" "Origem"
141 ]
142 []
143 ]
144 , li []
145 [ label [ for "connection-input-2" ] [ text "Destino" ]
146 , input
147 [ id "connection-input-2"
148 , class "cnpj-input"
149 , placeholder "CNPJ ou ID"
150 , value model.connectionInput2
151 , onInput UpdateConnectionInput2
152 , onEnter Search
153 , attribute "aria-label" "Destino"
154 ]
155 []
156 ]
157 , li []
158 [ button
159 [ onClick Search
160 , Html.Attributes.disabled (not (Set.isEmpty model.pending))
161 , class "primary"
162 ]
163 [ text
164 (if not (Set.isEmpty model.pending) then
165 "Carregando..."
166
167 else
168 "Buscar"
169 )
170 ]
171 ]
172 , clearButton model
173 ]
174 )
175 ]
176 ]
177 , main_ [ class "graph-viewport", onWheel Zoom ]
178 [ svg
179 [ SA.class "graph-svg"
180 , SA.width (String.fromFloat model.width)
181 , SA.height (String.fromFloat model.height)
182 , onMouseDown PanStart
183 ]
184 [ g [ SA.transform ("translate(" ++ String.fromFloat model.pan.x ++ "," ++ String.fromFloat model.pan.y ++ ") scale(" ++ String.fromFloat model.zoom ++ ")") ]
185 [ g [] (Set.toList model.edges |> List.filterMap (viewEdge model.nodes))
186 , g [] (Dict.values model.nodes |> List.map (viewNode model.jsonApi (fullyExplored model)))
187 ]
188 ]
189 , case model.error of
190 Just err ->
191 div [ class "error-overlay" ]
192 [ small [] [ text err ] ]
193
194 Nothing ->
195 text ""
196 , div [ class "status-overlay" ]
197 [ small []
198 [ text (String.fromInt companiesCount ++ " pessoas jurídicas, " ++ String.fromInt peopleCount ++ " pessoas físicas, " ++ String.fromInt (Set.size model.edges) ++ " conexões")
199 , if not (Set.isEmpty model.pending) then
200 span [ class "loading-indicator" ] [ text (" (Processando fila: " ++ String.fromInt (List.length model.queryQueue) ++ ")") ]
201
202 else
203 text ""
204 ]
205 ]
206 , infoPanel model.activeTab (Dict.isEmpty model.nodes)
207 ]
208 , footer [ class "app-footer" ]
209 [ small []
210 [ a [ href "https://tangled.org/cuducos.me/meu-garfo" ] [ text "Código aberto" ]
211 , text " 🩷 "
212 , text "Parte do "
213 , a [ href "https://apoia.se/minhareceita" ] [ text "Minha Receita" ]
214 ]
215 ]
216 ]
217
218
219clearButton : Model -> Html Msg
220clearButton model =
221 if Dict.isEmpty model.nodes then
222 text ""
223
224 else
225 li []
226 [ button
227 [ onClick Clear
228 , Html.Attributes.disabled (not (Set.isEmpty model.pending))
229 , class "secondary"
230 ]
231 [ text "Limpar" ]
232 ]
233
234
235companyStatusClass : CompanyStatus -> String
236companyStatusClass status =
237 case status of
238 StatusLoading ->
239 "company-active"
240
241 StatusActive ->
242 "company-active"
243
244 StatusInactive ->
245 "company-inactive"
246
247 StatusUnknown ->
248 "company-unknown"
249
250
251legend : Html Msg
252legend =
253 div [ class "legend" ]
254 [ span [ class "legend-item" ]
255 [ span [ class "legend-dot legend-company-active" ] []
256 , text "Empresa ativa"
257 ]
258 , span [ class "legend-item" ]
259 [ span [ class "legend-dot legend-company-inactive" ] []
260 , text "Empresa inativa"
261 ]
262 , span [ class "legend-item" ]
263 [ span [ class "legend-dot legend-company-unknown" ] []
264 , text "Empresa não encontrada"
265 ]
266 , span [ class "legend-item" ]
267 [ span [ class "legend-dot legend-person" ] []
268 , text "Pessoa física"
269 ]
270 ]
271
272
273methodologyText : Tab -> Html Msg
274methodologyText tab =
275 small []
276 [ case tab of
277 CnpjTab ->
278 div []
279 [ text "A partir do CNPJ informado, o grafo é construído em largura ("
280 , abbr
281 [ Html.Attributes.title "Busca em largura"
282 , Html.Attributes.attribute "aria-label" "Busca em largura"
283 ]
284 [ a [ href "https://pt.wikipedia.org/wiki/Busca_em_largura", Html.Attributes.attribute "target" "_blank", Html.Attributes.attribute "rel" "noopener noreferrer" ] [ text "BFS" ] ]
285 , text "): cada empresa traz seus sócios, e cada sócio traz as empresas em que participa. A expansão automática para em "
286 , em [] [ text "profundidade 8" ]
287 , text " ou "
288 , em [] [ text "32 nós" ]
289 , text " — o que vier primeiro. A partir daí, clique em qualquer nó com borda destacada para expandi-lo manualmente, um nível por vez, sem novos limites."
290 ]
291
292 ConnectionTab ->
293 div []
294 [ text "A API busca o menor caminho de relação entre as duas entidades (sócio-empresa) via busca bidirecional em largura, com limite de 90 segundos. O grafo exibe apenas os nós desse caminho, sem expansão automática. Clique nos nós para explorá-los individualmente. Se não houver caminho, a busca retorna vazia; se ultrapassar 90s, retorna erro de tempo esgotado — o que não significa ausência de conexão, apenas que o cálculo demorou demais."
295 , div [ class "info-panel-divider" ] []
296 , text "Para pessoas jurídicas, o identificador é o CNPJ. Para pessoas físicas, o identificador é um hash MD5 determinístico do CPF (com os dígitos redactos, tal como divulgados na fonte oficial) e do nome. Para encontrar o ID de uma pessoa, busque primeiro uma empresa da qual ela é sócia (aba CNPJ), clique no nó da pessoa para expandi-lo e copie o ID exibido no rótulo."
297 ]
298 ]
299
300
301infoPanel : Tab -> Bool -> Html Msg
302infoPanel tab isEmpty =
303 details [ class "info-panel" ]
304 [ summary [] [ small [] [ text "Como funciona esta busca?" ] ]
305 , if isEmpty then
306 methodologyText tab
307
308 else
309 div []
310 [ legend
311 , div [ class "info-panel-divider" ] []
312 , methodologyText tab
313 ]
314 ]
315
316
317onWheel : (Float -> Msg) -> Html.Attribute Msg
318onWheel tagger =
319 preventDefaultOn "wheel" (Decode.map (\delta -> ( tagger delta, True )) (Decode.field "deltaY" Decode.float))
320
321
322preventDefaultOnClick : msg -> Html.Attribute msg
323preventDefaultOnClick msg =
324 preventDefaultOn "click" (Decode.succeed ( msg, True ))
325
326
327onEnter : Msg -> Html.Attribute Msg
328onEnter msg =
329 Html.Events.on "keydown"
330 (Decode.field "key" Decode.string
331 |> Decode.andThen
332 (\key ->
333 if key == "Enter" then
334 Decode.succeed msg
335
336 else
337 Decode.fail "not Enter"
338 )
339 )
340
341
342onMouseDown : Msg -> Html.Attribute Msg
343onMouseDown msg =
344 custom "mousedown" (Decode.succeed { message = msg, stopPropagation = False, preventDefault = False })
345
346
347fullyExplored : Model -> Set String
348fullyExplored model =
349 Dict.foldl
350 (\id node acc ->
351 let
352 needed =
353 case node.entity of
354 Company _ _ _ ->
355 [ ( id, "qsa" ), ( id, "cnpjs" ) ]
356
357 Person _ _ ->
358 [ ( id, "cnpjs" ) ]
359
360 allDone =
361 List.all (\k -> Set.member k model.visited) needed
362 in
363 if allDone then
364 Set.insert id acc
365
366 else
367 acc
368 )
369 Set.empty
370 model.nodes
371
372
373viewEdge : Dict String Node -> ( String, String ) -> Maybe (Svg Msg)
374viewEdge nodes ( s, t ) =
375 case ( Dict.get s nodes, Dict.get t nodes ) of
376 ( Just sn, Just tn ) ->
377 Just
378 (line
379 [ SA.x1 (String.fromFloat sn.x)
380 , SA.y1 (String.fromFloat sn.y)
381 , SA.x2 (String.fromFloat tn.x)
382 , SA.y2 (String.fromFloat tn.y)
383 , SA.class "edge"
384 , stopPropagationOnMouseDown
385 ]
386 []
387 )
388
389 _ ->
390 Nothing
391
392
393viewNode : String -> Set String -> Node -> Svg Msg
394viewNode jsonApi visited node =
395 let
396 isVisited =
397 Set.member node.id visited
398
399 isRoot =
400 node.depth == 0
401
402 ( nodeClass, baseRadius ) =
403 case node.entity of
404 Company _ _ situacao ->
405 ( "node-company " ++ companyStatusClass situacao, 8 )
406
407 Person _ _ ->
408 ( "node-person", 5 )
409
410 radius =
411 if isRoot then
412 baseRadius + 6
413
414 else if isVisited then
415 baseRadius
416
417 else
418 baseRadius + 2
419
420 labelStr =
421 case node.entity of
422 Company name cnpj _ ->
423 let
424 maskedCnpj =
425 Format.mask cnpj
426 in
427 if String.isEmpty cnpj then
428 name
429
430 else if name == cnpj || String.isEmpty name then
431 maskedCnpj
432
433 else
434 name ++ " (" ++ maskedCnpj ++ ")"
435
436 Person name cpf ->
437 case cpf of
438 Just c ->
439 let
440 maskedCpf =
441 Format.mask c
442 in
443 if name == maskedCpf then
444 maskedCpf
445
446 else
447 name ++ " (" ++ maskedCpf ++ ")"
448
449 Nothing ->
450 name
451
452 plainLabel =
453 text_
454 [ SA.dy "18"
455 , SA.textAnchor "middle"
456 , SA.class "node-label"
457 , stopPropagationOnMouseDown
458 ]
459 [ text labelStr ]
460
461 labelElement =
462 case ( node.entity, node.error ) of
463 ( Company _ cnpj _, Nothing ) ->
464 let
465 url =
466 if String.right 1 jsonApi == "/" then
467 jsonApi ++ cnpj
468
469 else
470 jsonApi ++ "/" ++ cnpj
471 in
472 Svg.a [ SA.xlinkHref url, attribute "href" url, attribute "target" "_blank", attribute "rel" "noopener noreferrer" ]
473 [ text_
474 [ SA.dy "18"
475 , SA.textAnchor "middle"
476 , SA.class "node-label link"
477 , stopPropagationOnMouseDown
478 ]
479 [ text labelStr ]
480 ]
481
482 _ ->
483 plainLabel
484
485 errorElement =
486 case node.error of
487 Just msg ->
488 text_
489 [ SA.dy "32"
490 , SA.textAnchor "middle"
491 , SA.class "node-error"
492 , stopPropagationOnMouseDown
493 ]
494 [ text msg ]
495
496 Nothing ->
497 text ""
498 in
499 g
500 [ SA.transform ("translate(" ++ String.fromFloat node.x ++ "," ++ String.fromFloat node.y ++ ")")
501 , SA.class
502 (if isRoot then
503 "node-group root"
504
505 else
506 "node-group"
507 )
508 ]
509 [ circle
510 [ SA.r (String.fromFloat radius)
511 , SA.class
512 (nodeClass
513 ++ (if isVisited then
514 " visited"
515
516 else
517 " expandable"
518 )
519 ++ (if node.error /= Nothing then
520 " errored"
521
522 else
523 ""
524 )
525 ++ (if isRoot then
526 " root"
527
528 else
529 ""
530 )
531 )
532 , onNodeMouseDown node
533 ]
534 []
535 , labelElement
536 , errorElement
537 ]
538
539
540onNodeMouseDown : Node -> Svg.Attribute Msg
541onNodeMouseDown node =
542 SE.custom "mousedown"
543 (Decode.map3
544 (\id x y ->
545 { message = InteractionStart id x y
546 , stopPropagation = True
547 , preventDefault = False
548 }
549 )
550 (Decode.succeed node.id)
551 (Decode.field "clientX" Decode.float)
552 (Decode.field "clientY" Decode.float)
553 )
554
555
556stopPropagationOnMouseDown : Svg.Attribute Msg
557stopPropagationOnMouseDown =
558 SE.custom "mousedown"
559 (Decode.succeed
560 { message = InteractionMove 0 0
561 , stopPropagation = True
562 , preventDefault = False
563 }
564 )