Types.purs 22.7 KB
Newer Older
1
module Gargantext.Types where
2

3
import Data.Array as A
4
import Data.Newtype (class Newtype)
5
import Data.String as S
6
import Data.Generic.Rep (class Generic)
7 8 9
import Data.Eq.Generic (genericEq)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
10
import Data.Int (toNumber)
11
import Data.Maybe (Maybe(..), maybe)
12
import Effect.Aff (Aff)
13
import Foreign as F
14
import Prim.Row (class Union)
15
import Reactix as R
16
import Simple.JSON as JSON
17
import Simple.JSON.Generics as JSONG
James Laver's avatar
James Laver committed
18
import URI.Query (Query)
19

20 21
import Gargantext.Prelude

22 23
data Handed = LeftHanded | RightHanded

James Laver's avatar
James Laver committed
24 25 26 27
switchHanded :: forall a. a -> a -> Handed -> a
switchHanded l _ LeftHanded = l
switchHanded _ r RightHanded = r

28 29 30
reverseHanded :: forall a. Handed -> Array a -> Array a
reverseHanded LeftHanded a = A.reverse a
reverseHanded RightHanded a = a
James Laver's avatar
James Laver committed
31 32 33 34 35

flipHanded :: R.Element -> R.Element -> Handed -> R.Element
flipHanded l r LeftHanded  = R.fragment [r, l]
flipHanded l r RightHanded = R.fragment [l, r]

36 37
derive instance Generic Handed _
instance Eq Handed where
38 39
  eq = genericEq

James Laver's avatar
James Laver committed
40

41 42
type ID      = Int
type Name    = String
43

44
newtype SessionId = SessionId String
45
type NodeID = Int
46

47
derive instance Generic SessionId _
48

49
instance Eq SessionId where
50 51
  eq = genericEq

52
instance Show SessionId where
53 54
  show (SessionId s) = s

55
data TermSize = MonoTerm | MultiTerm
56

57
data Term = Term String TermList
58 59
derive instance Generic TermSize _
instance Eq TermSize where eq = genericEq
60

James Laver's avatar
James Laver committed
61 62 63 64
-- | Converts a data structure to a query string
class ToQuery a where
  toQuery :: a -> Query

65
instance Show TermSize where
66 67 68
  show MonoTerm  = "MonoTerm"
  show MultiTerm = "MultiTerm"

69
instance Read TermSize where
70 71 72 73
  read :: String -> Maybe TermSize
  read "MonoTerm"  = Just MonoTerm
  read "MultiTerm" = Just MultiTerm
  read _           = Nothing
74

75 76
termSizes :: Array { desc :: String, mval :: Maybe TermSize }
termSizes = [ { desc: "All types",        mval: Nothing        }
77 78 79 80
            , { desc: "One-word terms",   mval: Just MonoTerm  }
            , { desc: "Multi-word terms", mval: Just MultiTerm }
            ]

81
data TermList = MapTerm | StopTerm | CandidateTerm
82
-- TODO use generic JSON instance
83 84 85 86 87 88
derive instance Generic TermList _
instance Eq TermList where eq = genericEq
instance Ord TermList where compare = genericCompare
instance JSON.WriteForeign TermList where writeImpl = JSON.writeImpl <<< show
instance JSON.ReadForeign TermList where readImpl = JSONG.enumSumRep
instance Show TermList where show = genericShow
89

90 91
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
92
termListName MapTerm = "Map List"
93 94 95
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"

96
instance Read TermList where
97
  read :: String -> Maybe TermList
98
  read "MapTerm"     = Just MapTerm
99 100 101
  read "StopTerm"      = Just StopTerm
  read "CandidateTerm" = Just CandidateTerm
  read _               = Nothing
102 103 104

termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms",   mval: Nothing      }
105
            , { desc: "Map terms",   mval: Just MapTerm   }
106 107 108 109
            , { desc: "Stop terms",  mval: Just StopTerm  }
            , { desc: "Candidate terms", mval: Just CandidateTerm }
            ]

110
-- | Proof that row `r` is a subset of row `s`
111 112
class Optional (r :: Row Type) (s :: Row Type)
instance Union r t s => Optional r s
113 114 115 116

showTabType' :: TabType -> String
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
117
showTabType' (TabPairing  t) = show t
118

119
newtype TabPostQuery = TabPostQuery {
120 121 122 123 124 125
    offset :: Int
  , limit :: Int
  , orderBy :: OrderBy
  , tabType :: TabType
  , query :: String
  }
126 127 128
derive instance Generic TabPostQuery _
derive instance Newtype TabPostQuery _
derive newtype instance JSON.WriteForeign TabPostQuery
129

130
data NodeType = Annuaire
131 132 133
              | Corpus
              | Dashboard
              | Error
134 135 136 137
              | Folder
              | FolderPrivate
              | FolderPublic
              | FolderShared
138 139 140
              | Graph
              | Individu
              | Node
141
              | NodeContact
142
              | NodeList
143 144 145 146
              | NodeUser
              | Nodes
              | Phylo
              | Team
147
              | Texts
148 149
              | Tree
              | Url_Document
150
              -- TODO Optional Nodes
151
              | NodeFile
152
              | NodeFrameCalc
153
              | NodeFrameNotebook
154
              | NodeFrameWrite
155
              | NodeFrameVisio
156
              | NodePublic NodeType
157 158 159 160 161 162 163 164 165 166 167
derive instance Generic NodeType _
derive instance Eq NodeType
instance JSON.ReadForeign NodeType where
  readImpl f = do
    s <- F.readString f
    case read s of
      Nothing -> F.fail $ F.ErrorAtProperty s $ F.ForeignError "unknown property"
      Just nt -> pure nt
instance JSON.WriteForeign NodeType where writeImpl = JSON.writeImpl <<< show

instance Show NodeType where
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
  show NodeUser        = "NodeUser"

  show Folder          = "NodeFolder"
  show FolderPrivate   = "NodeFolderPrivate"  -- Node Private Worktop
  show FolderShared    = "NodeFolderShared"   -- Node Share Worktop
  show FolderPublic    = "NodeFolderPublic"   -- Node Public Worktop

  show Annuaire        = "NodeAnnuaire"
  show NodeContact     = "NodeContact"
  show Corpus          = "NodeCorpus"
  show Dashboard       = "NodeDashboard"
  show Url_Document    = "NodeDocument"
  show Error           = "NodeError"
  show Graph           = "NodeGraph"
  show Phylo           = "NodePhylo"
  show Individu        = "NodeIndividu"
  show Node            = "Node"
  show Nodes           = "Nodes"
  show Tree            = "NodeTree"
  show Team            = "NodeTeam"
  show NodeList        = "NodeList"
189
  show Texts           = "NodeDocs"
190 191
  show NodeFrameWrite  = "NodeFrameWrite"
  show NodeFrameCalc   = "NodeFrameCalc"
192 193
  show NodeFrameNotebook = "NodeFrameNotebook"
  show NodeFrameVisio    = "NodeFrameVisio"
194
  show (NodePublic nt) = "NodePublic" <> show nt
195
  show NodeFile        = "NodeFile"
196

197

198
instance Read NodeType where
199 200 201 202 203
  read "NodeUser"          = Just NodeUser
  read "NodeFolder"        = Just Folder
  read "NodeFolderPrivate" = Just FolderPrivate
  read "NodeFolderShared"  = Just FolderShared
  read "NodeFolderPublic"  = Just FolderPublic
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
  read "NodeAnnuaire"      = Just Annuaire
  read "NodeDashboard"     = Just Dashboard
  read "Document"          = Just Url_Document
  read "NodeGraph"         = Just Graph
  read "NodePhylo"         = Just Phylo
  read "Individu"          = Just Individu
  read "Node"              = Just Node
  read "Nodes"             = Just Nodes
  read "NodeCorpus"        = Just Corpus
  read "NodeContact"       = Just NodeContact
  read "Tree"              = Just Tree
  read "NodeTeam"          = Just Team
  read "NodeList"          = Just NodeList
  read "NodeTexts"         = Just Texts
  read "Annuaire"          = Just Annuaire
  read "NodeFrameWrite"    = Just NodeFrameWrite
  read "NodeFrameCalc"     = Just NodeFrameCalc
221
  read "NodeFrameNotebook"     = Just NodeFrameNotebook
222
  read "NodeFrameVisio"    = Just NodeFrameVisio
223
  read "NodeFile"          = Just NodeFile
224
  -- TODO NodePublic read ?
225
  read _                   = Nothing
226 227 228 229


fldr :: NodeType -> Boolean -> String
fldr NodeUser false = "fa fa-user-circle"
230 231
fldr NodeUser true  = "fa fa-user"
------------------------------------------------------
232 233
fldr Folder  false  = "fa fa-folder"
fldr Folder  true   = "fa fa-folder-open-o"
234
------------------------------------------------------
235
fldr FolderPrivate true  = "fa fa-lock"
236
fldr FolderPrivate false = "fa fa-lock-circle"
237

238
fldr FolderShared  true  = "fa fa-share-alt"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
239
fldr FolderShared  false = "fa fa-share-circle"
240
fldr Team  true   = "fa fa-users"
241
fldr Team  false  = "fa fa-users-closed"
242

243 244
fldr FolderPublic true  = "fa fa-globe-circle"
fldr FolderPublic false = "fa fa-globe"
245
------------------------------------------------------
246

247
fldr Corpus true  = "fa fa-book"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
248
fldr Corpus false = "fa fa-book-circle"
249 250 251 252 253 254 255

fldr Phylo _ = "fa fa-code-fork"

fldr Graph _ = "fa fa-hubzilla"
fldr Texts _ = "fa fa-newspaper-o"
fldr Dashboard _ = "fa fa-signal"
fldr NodeList _ = "fa fa-list"
256
fldr NodeFile _ = "fa fa-file"  -- TODO depending on mime type we can use fa-file-image etc
257

258 259
fldr Annuaire true  = "fa fa-address-card-o"
fldr Annuaire false = "fa fa-address-card"
260 261 262 263

fldr NodeContact true  = "fa fa-address-card-o"
fldr NodeContact false = "fa fa-address-card"

264
fldr NodeFrameWrite true  = "fa fa-file-text-o"
265
fldr NodeFrameWrite false = "fa fa-file-text"
266

267 268
fldr NodeFrameCalc true  = "fa fa-calculator"
fldr NodeFrameCalc false = "fa fa-calculator"
269

270 271
fldr NodeFrameNotebook true  = "fa fa-file-code-o"
fldr NodeFrameNotebook false = "fa fa-code"
272

273 274 275 276
fldr NodeFrameVisio true  = "fa fa-video-camera"
fldr NodeFrameVisio false = "fa fa-video-camera"


277

278
fldr (NodePublic nt) b   = fldr nt b
279

280
fldr _        true   = "fa fa-folder-open"
281
fldr _        false  = "fa fa-folder-o"
282 283


284 285 286
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt              = NodePublic nt
287

288 289 290 291
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic   = true
isPublic _              = false
292

293 294
{-
------------------------------------------------------------
295
instance Ord NodeType where
296 297
  compare n1 n2 = compare (show n1) (show n2)

298
instance Eq NodeType where
299 300 301 302
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
nodeTypePath :: NodeType -> String
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
nodeTypePath Folder          = "folder"
nodeTypePath FolderPrivate   = "folderPrivate"
nodeTypePath FolderShared    = "folderShared"
nodeTypePath FolderPublic    = "folderPublic"
nodeTypePath Annuaire        = "annuaire"
nodeTypePath Corpus          = "corpus"
nodeTypePath Dashboard       = "dashboard"
nodeTypePath Url_Document    = "document"
nodeTypePath Error           = "ErrorNodeType"
nodeTypePath Graph           = "graph"
nodeTypePath Phylo           = "phylo"
nodeTypePath Individu        = "individu"
nodeTypePath Node            = "node"
nodeTypePath Nodes           = "nodes"
nodeTypePath NodeUser        = "user"
nodeTypePath NodeContact     = "contact"
nodeTypePath Tree            = "tree"
nodeTypePath NodeList        = "lists"
nodeTypePath Texts           = "texts"
nodeTypePath Team            = "team"
nodeTypePath NodeFrameWrite  = "write"
nodeTypePath NodeFrameCalc   = "calc"
325 326
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath NodeFrameVisio    = "visio"
327
nodeTypePath (NodePublic nt) = nodeTypePath nt
328
nodeTypePath NodeFile        = "file"
329

330
------------------------------------------------------------
331 332 333 334 335
type CorpusId   = Int
type DocId      = Int
type ListId     = Int
type AnnuaireId = Int
type ContactId  = Int
336

337 338
data ScoreType = Occurrences

339
derive instance Generic ScoreType _
340 341
instance Eq ScoreType where eq = genericEq
instance Show ScoreType where show = genericShow
342

343 344
type SearchQuery = String

345
type NgramsGetOpts =
346 347
  { limit          :: Limit
  , listIds        :: Array ListId
348
  , offset         :: Maybe Offset
349
  , orderBy        :: Maybe OrderBy
350 351
  , searchQuery    :: SearchQuery
  , tabType        :: TabType
352 353 354 355
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  }

356
type NgramsGetTableAllOpts =
357 358
  { listIds        :: Array ListId
  , tabType        :: TabType
359 360
  }

361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
type SearchOpts =
  { {-id :: Int
    , query    :: Array String
    ,-}
    listId   :: Int
  , limit    :: Limit
  , offset   :: Offset
  , orderBy  :: Maybe OrderBy
  }

type CorpusMetricOpts =
  { tabType :: TabType
  , listId  :: ListId
  , limit   :: Maybe Limit
  }

type ChartOpts =
  { chartType :: ChartType
379
  , limit     :: Maybe Limit
380
  , listId    :: Maybe ListId
381 382 383
  , tabType   :: TabType
  }

James Laver's avatar
James Laver committed
384
data NodePath = NodePath SessionId NodeType (Maybe Id)
385 386

nodePath :: NodePath -> String
James Laver's avatar
James Laver committed
387
nodePath (NodePath s t i) = nodeTypePath t <> "/" <> show s <> id
James Laver's avatar
James Laver committed
388
  where id = maybe "" (\j -> "/" <> show j) i
389

390
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
391

392
instance Show ChartType
393
  where
394 395 396 397
    show Histo     = "chart"
    show Scatter   = "scatter"
    show ChartBar  = "bar"
    show ChartPie  = "pie"
398 399
    show ChartTree = "tree"

400 401 402 403 404 405 406 407
chartTypeFromString :: String -> Maybe ChartType
chartTypeFromString "bar"     = Just ChartBar
chartTypeFromString "chart"   = Just Histo
chartTypeFromString "pie"     = Just ChartPie
chartTypeFromString "scatter" = Just Scatter
chartTypeFromString "tree"    = Just ChartTree
chartTypeFromString _         = Nothing

408 409 410 411 412 413 414 415 416
type Id  = Int
type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

417
derive instance Generic OrderBy _
418 419 420
instance Show OrderBy where show = genericShow
instance JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
421 422

------------------------------------------------------------
423 424 425
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11

426
derive instance Generic ApiVersion _
427 428 429 430
instance JSON.ReadForeign ApiVersion where
  readImpl f = do
    s <- JSON.readImpl f
    case s of
431
      "v0"   -> pure V0
432 433
      "v1.0" -> pure V10
      "v1.1" -> pure V11
434
      x      -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
435
instance JSON.WriteForeign ApiVersion where
436
  writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
437
instance Show ApiVersion where
438
  show V0  = "v0"
439 440
  show V10 = "v1.0"
  show V11 = "v1.1"
441
instance Eq ApiVersion where
442 443 444
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false
445 446
------------------------------------------------------------

447 448
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
449
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
450
derive instance Generic CTabNgramType _
451 452 453
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
454 455 456 457
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"
458
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
459 460

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
461 462 463
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
464
instance Show PTabNgramType where
465 466 467
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
468
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
469 470

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
471 472 473 474 475 476 477 478 479 480 481 482 483 484
derive instance Generic (TabSubType a) _
instance Eq a => Eq (TabSubType a) where eq = genericEq
instance Ord a => Ord (TabSubType a) where compare = genericCompare
instance JSON.WriteForeign a => JSON.WriteForeign (TabSubType a) where
  writeImpl TabDocs = JSON.writeImpl { type: "TabDocs"
                                     , data: (Nothing :: Maybe String) }
  writeImpl (TabNgramType a) = JSON.writeImpl { type: "TabNgramType"
                                              , data: a }
  writeImpl TabTrash = JSON.writeImpl { type: "TabTrash"
                                      , data: (Nothing :: Maybe String) }
  writeImpl TabMoreLikeFav = JSON.writeImpl { type: "TabMoreLikeFav"
                                            , data: (Nothing :: Maybe String) }
  writeImpl TabMoreLikeTrash = JSON.writeImpl { type: "TabMoreLikeTrash"
                                              , data: (Nothing :: Maybe String) }
485
{-
486
instance DecodeJson a => DecodeJson (TabSubType a) where
487 488 489 490 491 492 493 494 495 496 497
  decodeJson j = do
    obj <- decodeJson j
    typ <- obj .: "type"
    dat <- obj .: "data"
    case typ of
      "TabDocs" -> TabDocs
      "TabNgramType" -> TabNgramType dat
      "TabTrash" -> TabTrash
      "TabMoreLikeFav" -> TabMoreLikeFav
      "TabMoreLikeTrash" -> TabMoreLikeTrash
      _ -> Left ("Unknown type '" <> typ <> "'") -}
498

499
instance Show a => Show (TabSubType a) where
500 501 502 503 504 505 506 507 508
  show TabDocs          = "Docs"
  show (TabNgramType a) = show a
  show TabTrash         = "Trash"
  show TabMoreLikeFav   = "MoreFav"
  show TabMoreLikeTrash = "MoreTrash"

data TabType
  = TabCorpus   (TabSubType CTabNgramType)
  | TabPairing  (TabSubType PTabNgramType)
509
  | TabDocument (TabSubType CTabNgramType)
510

511 512 513
derive instance Generic TabType _
derive instance Eq TabType
derive instance Ord TabType
514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532
instance Show TabType where show = genericShow
instance JSON.WriteForeign TabType where
  writeImpl (TabCorpus TabDocs)                         = JSON.writeImpl "Docs"
  writeImpl (TabCorpus (TabNgramType CTabAuthors))      = JSON.writeImpl "Authors"
  writeImpl (TabCorpus (TabNgramType CTabInstitutes))   = JSON.writeImpl "Institutes"
  writeImpl (TabCorpus (TabNgramType CTabSources))      = JSON.writeImpl "Sources"
  writeImpl (TabCorpus (TabNgramType CTabTerms))        = JSON.writeImpl "Terms"
  writeImpl (TabCorpus TabMoreLikeFav)                  = JSON.writeImpl "MoreFav"
  writeImpl (TabCorpus TabMoreLikeTrash)                = JSON.writeImpl "MoreTrash"
  writeImpl (TabCorpus TabTrash)                        = JSON.writeImpl "Trash"
  writeImpl (TabDocument TabDocs)                       = JSON.writeImpl "Docs"
  writeImpl (TabDocument (TabNgramType CTabAuthors))    = JSON.writeImpl "Authors"
  writeImpl (TabDocument (TabNgramType CTabInstitutes)) = JSON.writeImpl "Institutes"
  writeImpl (TabDocument (TabNgramType CTabSources))    = JSON.writeImpl "Sources"
  writeImpl (TabDocument (TabNgramType CTabTerms))      = JSON.writeImpl "Terms"
  writeImpl (TabDocument TabMoreLikeFav)                = JSON.writeImpl "MoreFav"
  writeImpl (TabDocument TabMoreLikeTrash)              = JSON.writeImpl "MoreTrash"
  writeImpl (TabDocument TabTrash)                      = JSON.writeImpl "Trash"
  writeImpl (TabPairing _d)                             = JSON.writeImpl "TabPairing"  -- TODO
533 534
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
535
instance DecodeJson TabType where
536 537 538 539 540 541 542 543 544
  decodeJson j = do
    obj <- decodeJson j
    typ <- obj .: "type"
    dat <- obj .: "data"
    case typ of
      "TabCorpus" -> TabCorpus dat
      "TabDocument" -> TabDocument dat
      "TabPairing" -> TabPairing dat
      _ -> Left ("Unknown type '" <> typ <> "'") -}
545 546 547

type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
548

549 550 551 552
data Mode = Authors
          | Sources
          | Institutes
          | Terms
553

554
derive instance Generic Mode _
555 556 557 558
instance Show Mode where show = genericShow
instance Eq Mode where eq = genericEq
instance Ord Mode where compare = genericCompare
instance JSON.WriteForeign Mode where writeImpl = JSON.writeImpl <<< show
559

560 561 562
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
563
modeTabType Sources    = CTabSources
564 565 566
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
567
modeFromString "Authors"    = Just Authors
568
modeFromString "Institutes" = Just Institutes
569
modeFromString "Sources"    = Just Sources
570 571
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
572

573 574 575
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
576
data AsyncTaskType = AddNode
577
                   | Form  -- this is file upload too
578
                   | GraphRecompute
579
                   | Query
580
                   | UpdateNgramsCharts
581
                   | UpdateNode
582
                   | UploadFile
583

584 585 586 587
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
  readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
588
  eq = genericEq
589
instance Show AsyncTaskType where
590
  show = genericShow
591 592

asyncTaskTypePath :: AsyncTaskType -> String
593 594 595 596
asyncTaskTypePath AddNode            = "async/nobody/"
asyncTaskTypePath Form               = "add/form/async/"
asyncTaskTypePath GraphRecompute     = "async/recompute/"
asyncTaskTypePath Query              = "query/"
597
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
598 599
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
600

601

602 603
type AsyncTaskID = String

604 605 606 607 608 609 610 611 612 613 614
data AsyncTaskStatus = IsRunning
                     | IsPending
                     | IsReceived
                     | IsStarted
                     | IsFailure
                     | IsFinished
                     | IsKilled
derive instance Generic AsyncTaskStatus _
instance JSON.ReadForeign AsyncTaskStatus where
  readImpl = JSONG.enumSumRep
instance Show AsyncTaskStatus where
615
  show = genericShow
616 617 618 619 620 621 622 623 624 625
derive instance Eq AsyncTaskStatus
-- instance Read AsyncTaskStatus where
--   read "IsFailure"  = Just Failed
--   read "IsFinished" = Just Finished
--   read "IsKilled"   = Just Killed
--   read "IsPending"  = Just Pending
--   read "IsReceived" = Just Received
--   read "IsRunning"  = Just Running
--   read "IsStarted"  = Just Started
--   read _            = Nothing
626

627 628 629 630 631
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

632 633 634
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
635
instance Eq AsyncTask where eq = genericEq
636 637 638 639 640

newtype AsyncTaskWithType = AsyncTaskWithType {
    task :: AsyncTask
  , typ  :: AsyncTaskType
  }
641 642 643 644
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
instance Eq AsyncTaskWithType where
645
  eq = genericEq
646

647 648 649 650 651
newtype AsyncProgress = AsyncProgress {
    id :: AsyncTaskID
  , log :: Array AsyncTaskLog
  , status :: AsyncTaskStatus
  }
652 653 654
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
655 656 657 658 659 660 661

newtype AsyncTaskLog = AsyncTaskLog {
    events :: Array String
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
662 663 664
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
665 666

progressPercent :: AsyncProgress -> Number
667
progressPercent (AsyncProgress {log}) = perc
668
  where
669 670 671
    perc = case A.head log of
      Nothing -> 0.0
      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
672
        where
673 674
          nom = toNumber $ failed + succeeded
          denom = toNumber $ failed + succeeded + remaining
675 676 677 678 679 680 681 682 683

---------------------------------------------------------------------------
-- | GarganText Internal Sugar

prettyNodeType :: NodeType -> String
prettyNodeType nt = S.replace (S.Pattern "Node")   (S.Replacement " ")
                  $ S.replace (S.Pattern "Folder") (S.Replacement " ")
                  $ show nt

684
---------------------------------------------------------------------------
685

686
data SidePanelState = InitialClosed | Opened | Closed
687
derive instance Generic SidePanelState _
688
instance Eq SidePanelState where eq = genericEq
689

690 691 692 693
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed