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

3 4
import Gargantext.Prelude

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

23 24 25 26
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)

27 28
data Handed = LeftHanded | RightHanded

James Laver's avatar
James Laver committed
29 30 31 32
switchHanded :: forall a. a -> a -> Handed -> a
switchHanded l _ LeftHanded = l
switchHanded _ r RightHanded = r

33 34 35
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
36 37 38 39 40

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

41 42
derive instance Generic Handed _
instance Eq Handed where
43 44
  eq = genericEq

James Laver's avatar
James Laver committed
45

46 47
type ID      = Int
type Name    = String
48

49
newtype SessionId = SessionId String
50
type NodeID = Int
51

52
derive instance Generic SessionId _
53

54
instance Eq SessionId where
55 56
  eq = genericEq

57
instance Show SessionId where
58 59
  show (SessionId s) = s

60
data TermSize = MonoTerm | MultiTerm
61

62
data Term = Term String TermList
63 64
derive instance Generic TermSize _
instance Eq TermSize where eq = genericEq
65

James Laver's avatar
James Laver committed
66 67 68 69
-- | Converts a data structure to a query string
class ToQuery a where
  toQuery :: a -> Query

70
instance Show TermSize where
71 72 73
  show MonoTerm  = "MonoTerm"
  show MultiTerm = "MultiTerm"

74
instance Read TermSize where
75 76 77 78
  read :: String -> Maybe TermSize
  read "MonoTerm"  = Just MonoTerm
  read "MultiTerm" = Just MultiTerm
  read _           = Nothing
79

80 81
termSizes :: Array { desc :: String, mval :: Maybe TermSize }
termSizes = [ { desc: "All types",        mval: Nothing        }
82 83 84 85
            , { desc: "One-word terms",   mval: Just MonoTerm  }
            , { desc: "Multi-word terms", mval: Just MultiTerm }
            ]

86
data TermList = MapTerm | StopTerm | CandidateTerm
87
-- TODO use generic JSON instance
88 89 90 91 92 93
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
94

95 96
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
97
termListName MapTerm = "Map List"
98 99 100
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"

101
instance Read TermList where
102
  read :: String -> Maybe TermList
103
  read "MapTerm"     = Just MapTerm
104 105 106
  read "StopTerm"      = Just StopTerm
  read "CandidateTerm" = Just CandidateTerm
  read _               = Nothing
107 108 109

termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms",   mval: Nothing      }
110
            , { desc: "Map terms",   mval: Just MapTerm   }
111 112 113 114
            , { desc: "Stop terms",  mval: Just StopTerm  }
            , { desc: "Candidate terms", mval: Just CandidateTerm }
            ]

115
-- | Proof that row `r` is a subset of row `s`
116 117
class Optional (r :: Row Type) (s :: Row Type)
instance Union r t s => Optional r s
118 119 120 121

showTabType' :: TabType -> String
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
122
showTabType' (TabPairing  t) = show t
123

124
newtype TabPostQuery = TabPostQuery {
125 126 127 128 129 130
    offset :: Int
  , limit :: Int
  , orderBy :: OrderBy
  , tabType :: TabType
  , query :: String
  }
131 132 133
derive instance Generic TabPostQuery _
derive instance Newtype TabPostQuery _
derive newtype instance JSON.WriteForeign TabPostQuery
134

135
data NodeType = Annuaire
136 137 138
              | Corpus
              | Dashboard
              | Error
139 140 141 142
              | Folder
              | FolderPrivate
              | FolderPublic
              | FolderShared
143 144 145
              | Graph
              | Individu
              | Node
146
              | NodeContact
147
              | NodeList
148 149 150 151
              | NodeUser
              | Nodes
              | Phylo
              | Team
152
              | Texts
153 154
              | Tree
              | Url_Document
155
              -- TODO Optional Nodes
156
              | NodeFile
157
              | NodeFrameCalc
158
              | NodeFrameNotebook
159
              | NodeFrameWrite
160
              | NodeFrameVisio
161
              | NodePublic NodeType
162 163 164 165 166 167 168 169 170 171 172
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
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
  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"
194
  show Texts           = "NodeDocs"
195 196
  show NodeFrameWrite  = "NodeFrameWrite"
  show NodeFrameCalc   = "NodeFrameCalc"
197 198
  show NodeFrameNotebook = "NodeFrameNotebook"
  show NodeFrameVisio    = "NodeFrameVisio"
199
  show (NodePublic nt) = "NodePublic" <> show nt
200
  show NodeFile        = "NodeFile"
201

202

203
instance Read NodeType where
204 205 206 207 208
  read "NodeUser"          = Just NodeUser
  read "NodeFolder"        = Just Folder
  read "NodeFolderPrivate" = Just FolderPrivate
  read "NodeFolderShared"  = Just FolderShared
  read "NodeFolderPublic"  = Just FolderPublic
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225
  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
226
  read "NodeFrameNotebook"     = Just NodeFrameNotebook
227
  read "NodeFrameVisio"    = Just NodeFrameVisio
228
  read "NodeFile"          = Just NodeFile
229
  -- TODO NodePublic read ?
230
  read _                   = Nothing
231

232
------------------------------------------------------
233

234 235
instance translateNodeType :: Translate NodeType where
  translate l n = case l of
236 237
    FR -> translateFR n
    _  -> translateEN n
238

239 240
translateFR :: NodeType -> String
translateFR = case _ of
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266
  Annuaire            -> "Annuaire"
  Corpus              -> "Corpus"
  Dashboard           -> "Dashboard"
  Error               -> "Erreur"
  Folder              -> "Dossier"
  FolderPrivate       -> "Dossier privé"
  FolderPublic        -> "Dossier public"
  FolderShared        -> "Dossier partagé"
  Graph               -> "Graphe"
  Individu            -> "Individu"
  Node                -> "Nœud"
  NodeContact         -> "Contact"
  NodeList            -> "Liste"
  NodeUser            -> "Utilisateur"
  Nodes               -> "Nœuds"
  Phylo               -> "Phylo"
  Team                -> "Équipe"
  Texts               -> "Textes"
  Tree                -> "Arbre"
  Url_Document        -> "Document URL"
  --
  NodeFile            -> "Fichier"
  NodeFrameCalc       -> "Feuilles de calcul"
  NodeFrameNotebook   -> "Carnet de notes"
  NodeFrameWrite      -> "Éditeur de texte"
  NodeFrameVisio      -> "Visio"
267
  NodePublic n        -> translateFR n
268

269 270
translateEN :: NodeType -> String
translateEN = case _ of
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
  Annuaire            -> "Annuaire"
  Corpus              -> "Corpus"
  Dashboard           -> "Dashboard"
  Error               -> "Error"
  Folder              -> "Folder"
  FolderPrivate       -> "Private folder"
  FolderPublic        -> "Public folder"
  FolderShared        -> "Shared folder"
  Graph               -> "Graph"
  Individu            -> "Person"
  Node                -> "Node"
  NodeContact         -> "Contact"
  NodeList            -> "List"
  NodeUser            -> "User"
  Nodes               -> "Nodes"
  Phylo               -> "Phylo"
  Team                -> "Team"
  Texts               -> "Texts"
  Tree                -> "Tree"
  Url_Document        -> "URL document"
  --
  NodeFile            -> "File"
  NodeFrameCalc       -> "Calc"
  NodeFrameNotebook   -> "Notebook"
  NodeFrameWrite      -> "Write"
  NodeFrameVisio      -> "Visio"
297
  NodePublic n        -> translateEN n
298 299

------------------------------------------------------
300

301 302 303
getIcon :: NodeType -> Boolean -> String
getIcon NodeUser false = "user-circle"
getIcon NodeUser true  = "user"
304
------------------------------------------------------
305 306
getIcon Folder  false  = "folder"
getIcon Folder  true   = "folder-open-o"
307
------------------------------------------------------
308 309
getIcon FolderPrivate true  = "lock"
getIcon FolderPrivate false = "lock-circle"
310

311 312 313 314
getIcon FolderShared  true  = "share-alt"
getIcon FolderShared  false = "share-circle"
getIcon Team  true   = "users"
getIcon Team  false  = "users-closed"
315

316 317
getIcon FolderPublic true  = "globe-circle"
getIcon FolderPublic false = "globe"
318
------------------------------------------------------
319

320 321
getIcon Corpus true  = "book"
getIcon Corpus false = "book-circle"
322

323
getIcon Phylo _ = "code-fork"
324

325 326 327 328 329
getIcon Graph _ = "hubzilla"
getIcon Texts _ = "newspaper-o"
getIcon Dashboard _ = "signal"
getIcon NodeList _ = "list"
getIcon NodeFile _ = "file"  -- TODO depending on mime type we can use fa-file-image etc
330

331 332
getIcon Annuaire true  = "address-card-o"
getIcon Annuaire false = "address-card"
333

334 335
getIcon NodeContact true  = "address-card-o"
getIcon NodeContact false = "address-card"
336

337 338
getIcon NodeFrameWrite true  = "file-text-o"
getIcon NodeFrameWrite false = "file-text"
339

340 341
getIcon NodeFrameCalc true  = "calculator"
getIcon NodeFrameCalc false = "calculator"
342

343 344
getIcon NodeFrameNotebook true  = "file-code-o"
getIcon NodeFrameNotebook false = "code"
345

346 347
getIcon NodeFrameVisio true  = "video-camera"
getIcon NodeFrameVisio false = "video-camera"
348

349 350


351
getIcon (NodePublic nt) b   = getIcon nt b
352

353 354
getIcon _        true   = "folder-open"
getIcon _        false  = "folder-o"
355

356 357 358
------------------------------------------------------

fldr :: NodeType -> Boolean -> String
359
fldr nt flag = classNamePrefix <> getIcon nt flag
360

361
charCodeIcon :: NodeType -> Boolean -> String
362
charCodeIcon nt flag = glyphiconToCharCode $ getIcon nt flag
363

364 365 366
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt              = NodePublic nt
367

368 369 370 371
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic   = true
isPublic _              = false
372

373 374
{-
------------------------------------------------------------
375
instance Ord NodeType where
376 377
  compare n1 n2 = compare (show n1) (show n2)

378
instance Eq NodeType where
379 380 381 382
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
nodeTypePath :: NodeType -> String
383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404
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"
405 406
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath NodeFrameVisio    = "visio"
407
nodeTypePath (NodePublic nt) = nodeTypePath nt
408
nodeTypePath NodeFile        = "file"
409

410
------------------------------------------------------------
411 412 413 414 415
type CorpusId   = Int
type DocId      = Int
type ListId     = Int
type AnnuaireId = Int
type ContactId  = Int
416

417 418
data ScoreType = Occurrences

419
derive instance Generic ScoreType _
420 421
instance Eq ScoreType where eq = genericEq
instance Show ScoreType where show = genericShow
422

423 424
type SearchQuery = String

425
type NgramsGetOpts =
426 427
  { limit          :: Limit
  , listIds        :: Array ListId
428
  , offset         :: Maybe Offset
429
  , orderBy        :: Maybe OrderBy
430 431
  , searchQuery    :: SearchQuery
  , tabType        :: TabType
432 433 434 435
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  }

436
type NgramsGetTableAllOpts =
437 438
  { listIds        :: Array ListId
  , tabType        :: TabType
439 440
  }

441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
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
459
  , limit     :: Maybe Limit
460
  , listId    :: Maybe ListId
461 462 463
  , tabType   :: TabType
  }

James Laver's avatar
James Laver committed
464
data NodePath = NodePath SessionId NodeType (Maybe Id)
465 466

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

470
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
471

472
instance Show ChartType
473
  where
474 475 476 477
    show Histo     = "chart"
    show Scatter   = "scatter"
    show ChartBar  = "bar"
    show ChartPie  = "pie"
478 479
    show ChartTree = "tree"

480 481 482 483 484 485 486 487
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

488 489 490 491 492 493 494 495 496
type Id  = Int
type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

497
derive instance Generic OrderBy _
498 499 500
instance Show OrderBy where show = genericShow
instance JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
501 502

------------------------------------------------------------
503 504 505
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11

506
derive instance Generic ApiVersion _
507 508 509 510
instance JSON.ReadForeign ApiVersion where
  readImpl f = do
    s <- JSON.readImpl f
    case s of
511
      "v0"   -> pure V0
512 513
      "v1.0" -> pure V10
      "v1.1" -> pure V11
514
      x      -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
515
instance JSON.WriteForeign ApiVersion where
516
  writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
517
instance Show ApiVersion where
518
  show V0  = "v0"
519 520
  show V10 = "v1.0"
  show V11 = "v1.1"
521
instance Eq ApiVersion where
522 523 524
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false
525 526
------------------------------------------------------------

527 528
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
529
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
530
derive instance Generic CTabNgramType _
531 532 533
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
534 535 536 537
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"
538
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
539 540

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
541 542 543
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
544
instance Show PTabNgramType where
545 546 547
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
548
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
549 550

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
551 552 553 554 555 556 557 558 559 560 561 562 563 564
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) }
565
{-
566
instance DecodeJson a => DecodeJson (TabSubType a) where
567 568 569 570 571 572 573 574 575 576 577
  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 <> "'") -}
578

579
instance Show a => Show (TabSubType a) where
580 581 582 583 584 585 586 587 588
  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)
589
  | TabDocument (TabSubType CTabNgramType)
590

591 592 593
derive instance Generic TabType _
derive instance Eq TabType
derive instance Ord TabType
594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612
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
613 614
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
615
instance DecodeJson TabType where
616 617 618 619 620 621 622 623 624
  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 <> "'") -}
625 626 627

type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
628
type AffETableResult a = Aff (Either RESTError (TableResult a))
629

630 631 632 633
data Mode = Authors
          | Sources
          | Institutes
          | Terms
634

635
derive instance Generic Mode _
636 637 638 639
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
640

641 642 643
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
644
modeTabType Sources    = CTabSources
645 646 647
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
648
modeFromString "Authors"    = Just Authors
649
modeFromString "Institutes" = Just Institutes
650
modeFromString "Sources"    = Just Sources
651 652
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
653

654 655 656
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
657
data AsyncTaskType = AddNode
658
                   | CorpusFormUpload  -- this is file upload too
659
                   | GraphRecompute
660
                   | ListUpload
661
                   | ListCSVUpload  -- legacy v3 CSV upload for lists
662
                   | Query
663
                   | UpdateNgramsCharts
664
                   | UpdateNode
665
                   | UploadFile
666
                   | UploadFrameCalc
667

668 669 670 671
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
  readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
672
  eq = genericEq
673
instance Show AsyncTaskType where
674
  show = genericShow
675 676

asyncTaskTypePath :: AsyncTaskType -> String
677
asyncTaskTypePath AddNode            = "async/nobody/"
678
asyncTaskTypePath CorpusFormUpload   = "add/form/async/"
679
asyncTaskTypePath GraphRecompute     = "async/recompute/"
680 681
asyncTaskTypePath ListUpload         = "add/form/async/"
asyncTaskTypePath ListCSVUpload      = "csv/add/form/async/"
682
asyncTaskTypePath Query              = "query/"
683
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
684 685
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
686
asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
687

688

689 690
type AsyncTaskID = String

691 692 693 694 695 696 697 698 699 700 701
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
702
  show = genericShow
703 704 705 706 707 708 709 710 711 712
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
713

714 715 716 717 718
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

719 720 721
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
722
instance Eq AsyncTask where eq = genericEq
723 724 725 726 727

newtype AsyncTaskWithType = AsyncTaskWithType {
    task :: AsyncTask
  , typ  :: AsyncTaskType
  }
728 729 730 731
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
instance Eq AsyncTaskWithType where
732
  eq = genericEq
733

734 735 736 737 738
newtype AsyncProgress = AsyncProgress {
    id :: AsyncTaskID
  , log :: Array AsyncTaskLog
  , status :: AsyncTaskStatus
  }
739 740 741
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
742 743 744 745 746 747 748

newtype AsyncTaskLog = AsyncTaskLog {
    events :: Array String
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
749 750 751
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
752 753

progressPercent :: AsyncProgress -> Number
754
progressPercent (AsyncProgress {log}) = perc
755
  where
756 757 758
    perc = case A.head log of
      Nothing -> 0.0
      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
759
        where
760 761
          nom = toNumber $ failed + succeeded
          denom = toNumber $ failed + succeeded + remaining
762 763 764 765 766 767 768 769 770

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

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

771
---------------------------------------------------------------------------
772

773
data SidePanelState = InitialClosed | Opened | Closed
774
derive instance Generic SidePanelState _
775
instance Eq SidePanelState where eq = genericEq
776

777 778 779 780
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed
781 782 783

---------------------------------------------------------------------------

784
data FrontendError = FStringError
785
  { error :: String
786 787
  } | FRESTError
  { error :: RESTError }
788 789 790

derive instance Generic FrontendError _
instance Eq FrontendError where eq = genericEq