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

3 4
import Gargantext.Prelude

5
import Data.Array as A
6
import Data.Eq.Generic (genericEq)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
7
import Data.Generic.Rep (class Generic)
8
import Data.Int (toNumber)
9
import Data.Maybe (Maybe(..), maybe)
10
import Data.Newtype (class Newtype)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
11
import Data.Ord.Generic (genericCompare)
12
import Data.Show.Generic (genericShow)
13
import Data.String as S
14
import Effect.Aff (Aff)
15
import Foreign as F
16
import Gargantext.Components.Lang (class Translate, Lang(..))
17
import Gargantext.Config.REST (RESTError, AffRESTError)
18
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
19 20
import GraphQL.Client.Args (class ArgGql)
import GraphQL.Client.Variables.TypeName (class VarTypeName)
21
import Prim.Row (class Union)
22
import Reactix as R
23
import Simple.JSON as JSON
24
import Simple.JSON.Generics as JSONG
James Laver's avatar
James Laver committed
25
import URI.Query (Query)
26

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
              | Context
147
              | NodeContact
148
              | NodeList
149 150 151 152
              | NodeUser
              | Nodes
              | Phylo
              | Team
153
              | NodeTexts
154 155
              | Tree
              | Url_Document
156
              -- TODO Optional Nodes
157
              | NodeFile
158
              | NodeFrameCalc
159
              | NodeFrameNotebook
160
              | NodeFrameWrite
161
              | NodeFrameVisio
162
              | NodePublic NodeType
163 164 165 166 167 168 169 170 171
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
172 173 174
instance ArgGql NodeType NodeType
instance VarTypeName NodeType where
  varTypeName _ = "NodeType!"
175 176

instance Show NodeType where
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
  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"
195
  show Context         = "Context"
196 197 198
  show Tree            = "NodeTree"
  show Team            = "NodeTeam"
  show NodeList        = "NodeList"
199
  show NodeTexts       = "NodeTexts"
200 201
  show NodeFrameWrite  = "NodeFrameWrite"
  show NodeFrameCalc   = "NodeFrameCalc"
202 203
  show NodeFrameNotebook = "NodeFrameNotebook"
  show NodeFrameVisio    = "NodeFrameVisio"
204
  show (NodePublic nt) = "NodePublic" <> show nt
205
  show NodeFile        = "NodeFile"
206

207

208
instance Read NodeType where
209 210 211 212 213
  read "NodeUser"          = Just NodeUser
  read "NodeFolder"        = Just Folder
  read "NodeFolderPrivate" = Just FolderPrivate
  read "NodeFolderShared"  = Just FolderShared
  read "NodeFolderPublic"  = Just FolderPublic
214 215 216 217 218 219 220 221
  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
222
  read "Context"           = Just Context
223 224 225 226 227
  read "NodeCorpus"        = Just Corpus
  read "NodeContact"       = Just NodeContact
  read "Tree"              = Just Tree
  read "NodeTeam"          = Just Team
  read "NodeList"          = Just NodeList
228
  read "NodeTexts"         = Just NodeTexts
229 230 231
  read "Annuaire"          = Just Annuaire
  read "NodeFrameWrite"    = Just NodeFrameWrite
  read "NodeFrameCalc"     = Just NodeFrameCalc
232
  read "NodeFrameNotebook"     = Just NodeFrameNotebook
233
  read "NodeFrameVisio"    = Just NodeFrameVisio
234
  read "NodeFile"          = Just NodeFile
235
  -- TODO NodePublic read ?
236
  read _                   = Nothing
237

238
------------------------------------------------------
239

240 241
instance translateNodeType :: Translate NodeType where
  translate l n = case l of
242 243
    FR -> translateFR n
    _  -> translateEN n
244

245 246
translateFR :: NodeType -> String
translateFR = case _ of
247 248 249 250 251 252 253 254 255 256 257
  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"
258
  Context             -> "ConTexte"
259 260 261 262 263 264
  NodeContact         -> "Contact"
  NodeList            -> "Liste"
  NodeUser            -> "Utilisateur"
  Nodes               -> "Nœuds"
  Phylo               -> "Phylo"
  Team                -> "Équipe"
265
  NodeTexts           -> "Docs"
266 267 268 269 270 271 272 273
  Tree                -> "Arbre"
  Url_Document        -> "Document URL"
  --
  NodeFile            -> "Fichier"
  NodeFrameCalc       -> "Feuilles de calcul"
  NodeFrameNotebook   -> "Carnet de notes"
  NodeFrameWrite      -> "Éditeur de texte"
  NodeFrameVisio      -> "Visio"
274
  NodePublic n        -> translateFR n
275

276 277
translateEN :: NodeType -> String
translateEN = case _ of
278 279 280 281 282 283 284 285 286 287 288
  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"
289
  Context             -> "Context"
290 291 292 293 294 295
  NodeContact         -> "Contact"
  NodeList            -> "List"
  NodeUser            -> "User"
  Nodes               -> "Nodes"
  Phylo               -> "Phylo"
  Team                -> "Team"
296
  NodeTexts           -> "Docs"
297 298 299 300 301 302 303 304
  Tree                -> "Tree"
  Url_Document        -> "URL document"
  --
  NodeFile            -> "File"
  NodeFrameCalc       -> "Calc"
  NodeFrameNotebook   -> "Notebook"
  NodeFrameWrite      -> "Write"
  NodeFrameVisio      -> "Visio"
305
  NodePublic n        -> translateEN n
306 307

------------------------------------------------------
308

arturo's avatar
arturo committed
309
-- @NOTE: #379 deprecate the idea of circle/non-circle icons
310 311 312
getIcon :: NodeType -> Boolean -> String
getIcon NodeUser false = "user-circle"
getIcon NodeUser true  = "user"
313
------------------------------------------------------
314 315
getIcon Folder  false  = "folder"
getIcon Folder  true   = "folder-open-o"
316
------------------------------------------------------
317 318
getIcon FolderPrivate true  = "lock"
getIcon FolderPrivate false = "lock-circle"
319

320 321 322 323
getIcon FolderShared  true  = "share-alt"
getIcon FolderShared  false = "share-circle"
getIcon Team  true   = "users"
getIcon Team  false  = "users-closed"
324

325 326
getIcon FolderPublic true  = "globe-circle"
getIcon FolderPublic false = "globe"
327
------------------------------------------------------
328

329 330
getIcon Corpus true  = "book"
getIcon Corpus false = "book-circle"
331

332
getIcon Phylo _ = "code-fork"
333

334
getIcon Graph _ = "hubzilla"
335
getIcon NodeTexts _ = "newspaper-o"
336 337 338
getIcon Dashboard _ = "signal"
getIcon NodeList _ = "list"
getIcon NodeFile _ = "file"  -- TODO depending on mime type we can use fa-file-image etc
339

340 341
getIcon Annuaire true  = "address-card-o"
getIcon Annuaire false = "address-card"
342

343 344
getIcon NodeContact true  = "address-card-o"
getIcon NodeContact false = "address-card"
345

346 347
getIcon NodeFrameWrite true  = "file-text-o"
getIcon NodeFrameWrite false = "file-text"
348

349 350
getIcon NodeFrameCalc true  = "calculator"
getIcon NodeFrameCalc false = "calculator"
351

352 353
getIcon NodeFrameNotebook true  = "file-code-o"
getIcon NodeFrameNotebook false = "code"
354

355 356
getIcon NodeFrameVisio true  = "video-camera"
getIcon NodeFrameVisio false = "video-camera"
357

358 359


360
getIcon (NodePublic nt) b   = getIcon nt b
361

362 363
getIcon _        true   = "folder-open"
getIcon _        false  = "folder-o"
364

365 366 367
------------------------------------------------------

fldr :: NodeType -> Boolean -> String
368
fldr nt flag = classNamePrefix <> getIcon nt flag
369

370
charCodeIcon :: NodeType -> Boolean -> String
371
charCodeIcon nt flag = glyphiconToCharCode $ getIcon nt flag
372

373 374 375
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt              = NodePublic nt
376

377 378 379 380
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic   = true
isPublic _              = false
381

382 383
{-
------------------------------------------------------------
384
instance Ord NodeType where
385 386
  compare n1 n2 = compare (show n1) (show n2)

387
instance Eq NodeType where
388 389 390 391
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
nodeTypePath :: NodeType -> String
392 393 394 395 396 397 398 399 400 401 402 403 404 405
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"
406
nodeTypePath Context         = "context"
407 408 409 410
nodeTypePath NodeUser        = "user"
nodeTypePath NodeContact     = "contact"
nodeTypePath Tree            = "tree"
nodeTypePath NodeList        = "lists"
411
nodeTypePath NodeTexts       = "texts"
412 413 414
nodeTypePath Team            = "team"
nodeTypePath NodeFrameWrite  = "write"
nodeTypePath NodeFrameCalc   = "calc"
415 416
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath NodeFrameVisio    = "visio"
417
nodeTypePath (NodePublic nt) = nodeTypePath nt
418
nodeTypePath NodeFile        = "file"
419

420
------------------------------------------------------------
421 422 423 424 425
type CorpusId   = Int
type DocId      = Int
type ListId     = Int
type AnnuaireId = Int
type ContactId  = Int
426

427 428
data ScoreType = Occurrences

429
derive instance Generic ScoreType _
430 431
instance Eq ScoreType where eq = genericEq
instance Show ScoreType where show = genericShow
432

433 434
type SearchQuery = String

435
type NgramsGetOpts =
436 437
  { limit          :: Limit
  , listIds        :: Array ListId
438
  , offset         :: Maybe Offset
439
  , orderBy        :: Maybe OrderBy
440 441
  , searchQuery    :: SearchQuery
  , tabType        :: TabType
442 443 444 445
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  }

446
type NgramsGetTableAllOpts =
447 448
  { listIds        :: Array ListId
  , tabType        :: TabType
449 450
  }

451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
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
469
  , limit     :: Maybe Limit
470
  , listId    :: Maybe ListId
471 472 473
  , tabType   :: TabType
  }

James Laver's avatar
James Laver committed
474
data NodePath = NodePath SessionId NodeType (Maybe Id)
475 476

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

480
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
481

482
instance Show ChartType
483
  where
484 485 486 487
    show Histo     = "chart"
    show Scatter   = "scatter"
    show ChartBar  = "bar"
    show ChartPie  = "pie"
488 489
    show ChartTree = "tree"

490 491 492 493 494 495 496 497
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

498 499 500 501 502 503 504 505 506
type Id  = Int
type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

507
derive instance Generic OrderBy _
508 509 510
instance Show OrderBy where show = genericShow
instance JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
511 512

------------------------------------------------------------
513 514 515
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11

516
derive instance Generic ApiVersion _
517 518 519 520
instance JSON.ReadForeign ApiVersion where
  readImpl f = do
    s <- JSON.readImpl f
    case s of
521
      "v0"   -> pure V0
522 523
      "v1.0" -> pure V10
      "v1.1" -> pure V11
524
      x      -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
525
instance JSON.WriteForeign ApiVersion where
526
  writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
527
instance Show ApiVersion where
528
  show V0  = "v0"
529 530
  show V10 = "v1.0"
  show V11 = "v1.1"
531
instance Eq ApiVersion where
532 533 534
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false
535 536
------------------------------------------------------------

537 538
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
539
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
540
derive instance Generic CTabNgramType _
541 542 543
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
544 545 546 547
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"
548
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
549 550

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
551 552 553
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
554
instance Show PTabNgramType where
555 556 557
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
558
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
559 560

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
561 562 563 564 565 566 567 568 569 570 571 572 573 574
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) }
575
{-
576
instance DecodeJson a => DecodeJson (TabSubType a) where
577 578 579 580 581 582 583 584 585 586 587
  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 <> "'") -}
588

589
instance Show a => Show (TabSubType a) where
590 591 592 593 594 595 596 597 598
  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)
599
  | TabDocument (TabSubType CTabNgramType)
600

601 602 603
derive instance Generic TabType _
derive instance Eq TabType
derive instance Ord TabType
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
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
623 624
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
625
instance DecodeJson TabType where
626 627 628 629 630 631 632 633 634
  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 <> "'") -}
635 636 637

type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
638
type AffETableResult a = AffRESTError (TableResult a)
639

640 641 642 643
data Mode = Authors
          | Sources
          | Institutes
          | Terms
644

645
derive instance Generic Mode _
646 647 648 649
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
650

651 652 653
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
654
modeTabType Sources    = CTabSources
655 656 657
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
658
modeFromString "Authors"    = Just Authors
659
modeFromString "Institutes" = Just Institutes
660
modeFromString "Sources"    = Just Sources
661 662
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
663

664 665 666
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
667
data AsyncTaskType = AddNode
668
                   | CorpusFormUpload  -- this is file upload too
669
                   | GraphRecompute
670
                   | ListUpload
671
                   | ListCSVUpload  -- legacy v3 CSV upload for lists
arturo's avatar
arturo committed
672
                   | NodeDocument
673
                   | Query
674
                   | UpdateNgramsCharts
675
                   | UpdateNode
676
                   | UploadFile
677
                   | UploadFrameCalc
678

679 680 681 682
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
  readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
683
  eq = genericEq
684
instance Show AsyncTaskType where
685
  show = genericShow
686 687

asyncTaskTypePath :: AsyncTaskType -> String
688
asyncTaskTypePath AddNode            = "async/nobody/"
689
asyncTaskTypePath CorpusFormUpload   = "add/form/async/"
690
asyncTaskTypePath GraphRecompute     = "async/recompute/"
691 692
asyncTaskTypePath ListUpload         = "add/form/async/"
asyncTaskTypePath ListCSVUpload      = "csv/add/form/async/"
arturo's avatar
arturo committed
693
asyncTaskTypePath NodeDocument       = "document/upload/async"
694
asyncTaskTypePath Query              = "query/"
695
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
696 697
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
698
asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
699

700

701 702
type AsyncTaskID = String

703 704 705 706 707 708 709 710 711 712 713
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
714
  show = genericShow
715 716 717 718 719 720 721 722 723 724
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
725

726 727 728 729 730
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

731 732 733
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
734
instance Eq AsyncTask where eq = genericEq
735

736 737
newtype AsyncTaskWithType = AsyncTaskWithType
  { task :: AsyncTask
738 739
  , typ  :: AsyncTaskType
  }
740 741 742
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
743
instance Eq AsyncTaskWithType where eq = genericEq
744

745
newtype AsyncProgress = AsyncProgress
746 747 748
  { id     :: AsyncTaskID
  , error  :: Maybe String
  , log    :: Array AsyncTaskLog
749 750
  , status :: AsyncTaskStatus
  }
751 752 753
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
754

755 756 757 758 759 760 761 762 763 764
newtype AsyncEvent = AsyncEvent
  { level :: String
  , message :: String
  }
derive instance Generic AsyncEvent _
derive instance Newtype AsyncEvent _
derive newtype instance JSON.ReadForeign AsyncEvent

newtype AsyncTaskLog = AsyncTaskLog
  { events :: Array AsyncEvent
765 766 767 768
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
769 770 771
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
772 773

progressPercent :: AsyncProgress -> Number
774
progressPercent (AsyncProgress { log }) = perc
775
  where
776 777 778
    perc = case A.head log of
      Nothing -> 0.0
      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
779
        where
780 781
          nom = toNumber $ failed + succeeded
          denom = toNumber $ failed + succeeded + remaining
782 783 784 785 786 787 788 789 790

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

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

791
---------------------------------------------------------------------------
792

793
data SidePanelState = InitialClosed | Opened | Closed
794
derive instance Generic SidePanelState _
795
instance Eq SidePanelState where eq = genericEq
796

797 798 799 800
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed
801 802 803

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

804 805 806
data FrontendError =
    FStringError { error :: String }
  | FRESTError { error :: RESTError }
807
  | FOtherError { error :: String }
808 809 810

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