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

3 4
import Gargantext.Prelude

5
import Data.Argonaut as Argonaut
6
import Data.Array as A
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 Gargantext.Components.Lang (class Translate, Lang(..))
18
import Gargantext.Config.REST (RESTError, AffRESTError)
19
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
20
import Gargantext.Utils.SimpleJSON (encodeJsonArgonaut)
21 22
import GraphQL.Client.Args (class ArgGql)
import GraphQL.Client.Variables.TypeName (class VarTypeName)
23
import Prim.Row (class Union)
24
import Reactix as R
25
import Simple.JSON as JSON
26
import Simple.JSON.Generics as JSONG
James Laver's avatar
James Laver committed
27
import URI.Query (Query)
28

29 30
data Handed = LeftHanded | RightHanded

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

35 36 37
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
38 39 40 41 42

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

43 44
derive instance Generic Handed _
instance Eq Handed where
45 46
  eq = genericEq

James Laver's avatar
James Laver committed
47

48 49
type ID      = Int
type Name    = String
50

51
newtype SessionId = SessionId String
52
type NodeID = Int
53

54
derive instance Generic SessionId _
55

56
instance Eq SessionId where
57 58
  eq = genericEq

59
instance Show SessionId where
60 61
  show (SessionId s) = s

62
data TermSize = MonoTerm | MultiTerm
63

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

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

72
instance Show TermSize where
73 74 75
  show MonoTerm  = "MonoTerm"
  show MultiTerm = "MultiTerm"

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

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

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

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

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

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

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

showTabType' :: TabType -> String
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
124
showTabType' (TabPairing  t) = show t
125

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

137
data NodeType = Annuaire
138 139 140
              | Corpus
              | Dashboard
              | Error
141 142 143 144
              | Folder
              | FolderPrivate
              | FolderPublic
              | FolderShared
145 146 147
              | Graph
              | Individu
              | Node
148
              | Context
149
              | NodeContact
150
              | NodeList
151 152 153 154
              | NodeUser
              | Nodes
              | Phylo
              | Team
155
              | NodeTexts
156 157
              | Tree
              | Url_Document
158
              -- TODO Optional Nodes
159
              | NodeFile
160
              | Calc
161
              | NodeFrameNotebook
162
              | Notes
163
              | NodeFrameVisio
164
              | NodePublic NodeType
165 166 167 168 169 170 171 172 173
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
174 175
instance Argonaut.EncodeJson NodeType where encodeJson = encodeJsonArgonaut
instance ArgGql String NodeType
176 177 178
instance ArgGql NodeType NodeType
instance VarTypeName NodeType where
  varTypeName _ = "NodeType!"
179 180

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

211

212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
prettyNodeType :: NodeType -> String
prettyNodeType (NodePublic nt)   = "Public " <> prettyNodeType nt
prettyNodeType Annuaire          = "Annuaire"
prettyNodeType Calc              = "Calc"
prettyNodeType Context           = "Context"
prettyNodeType Corpus            = "Corpus"
prettyNodeType Dashboard         = "Dashboard"
prettyNodeType Error             = "Error"
prettyNodeType Folder            = "Folder"
prettyNodeType FolderPrivate     = "Private folder"
prettyNodeType FolderPublic      = "Public folder"
prettyNodeType FolderShared      = "Shared folder"
prettyNodeType Graph             = "Graph"
prettyNodeType Individu          = "Individu"
prettyNodeType Node              = "Node"
prettyNodeType NodeContact       = "Contact"
prettyNodeType NodeFile          = "File"
prettyNodeType NodeFrameNotebook = "Notebook"
prettyNodeType NodeFrameVisio    = "Visio"
prettyNodeType NodeList          = "Terms"
prettyNodeType NodeTexts         = "Docs"
prettyNodeType NodeUser          = "User"
prettyNodeType Nodes             = "Nodes"
prettyNodeType Notes             = "Notes"
prettyNodeType Phylo             = "Phylo"
prettyNodeType Team              = "Team"
prettyNodeType Tree              = "Tree"
prettyNodeType Url_Document      = "Document"



243
instance Read NodeType where
244 245 246 247 248 249 250 251 252 253
  read "Calc"              = Just Calc
  read "Context"           = Just Context
  read "Document"          = Just Url_Document
  read "Individu"          = Just Individu
  read "Node"              = Just Node
  read "NodeAnnuaire"      = Just Annuaire
  read "NodeContact"       = Just NodeContact
  read "NodeCorpus"        = Just Corpus
  read "NodeDashboard"     = Just Dashboard
  read "NodeFile"          = Just NodeFile
254 255 256
  read "NodeFolder"        = Just Folder
  read "NodeFolderPrivate" = Just FolderPrivate
  read "NodeFolderPublic"  = Just FolderPublic
257 258 259
  read "NodeFolderShared"  = Just FolderShared
  read "NodeFrameNotebook" = Just NodeFrameNotebook
  read "NodeFrameVisio"    = Just NodeFrameVisio
260
  read "NodeGraph"         = Just Graph
261
  read "NodeList"          = Just NodeList
262 263
  read "NodePhylo"         = Just Phylo
  read "NodeTeam"          = Just Team
264
  read "NodeTexts"         = Just NodeTexts
265 266 267 268
  read "NodeUser"          = Just NodeUser
  read "Nodes"             = Just Nodes
  read "Notes"             = Just Notes
  read "Tree"              = Just Tree
269
  -- TODO NodePublic read ?
270
  read _                   = Nothing
271

272
------------------------------------------------------
273

274 275
instance translateNodeType :: Translate NodeType where
  translate l n = case l of
276 277
    FR -> translateFR n
    _  -> translateEN n
278

279 280
translateFR :: NodeType -> String
translateFR = case _ of
281 282 283 284 285 286 287 288 289 290 291
  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"
292
  Context             -> "ConTexte"
293
  NodeContact         -> "Contact"
294
  NodeList            -> "Terms"
295 296 297 298
  NodeUser            -> "Utilisateur"
  Nodes               -> "Nœuds"
  Phylo               -> "Phylo"
  Team                -> "Équipe"
299
  NodeTexts           -> "Docs"
300 301 302 303
  Tree                -> "Arbre"
  Url_Document        -> "Document URL"
  --
  NodeFile            -> "Fichier"
304
  Calc       -> "Feuilles de calcul"
305
  NodeFrameNotebook   -> "Carnet de notes"
306
  Notes      -> "Éditeur de texte"
307
  NodeFrameVisio      -> "Visio"
308
  NodePublic n        -> translateFR n
309

310 311
translateEN :: NodeType -> String
translateEN = case _ of
312 313 314 315 316 317 318 319 320 321 322
  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"
323
  Context             -> "Context"
324
  NodeContact         -> "Contact"
325
  NodeList            -> "Terms"
326 327 328 329
  NodeUser            -> "User"
  Nodes               -> "Nodes"
  Phylo               -> "Phylo"
  Team                -> "Team"
330
  NodeTexts           -> "Docs"
331 332 333 334
  Tree                -> "Tree"
  Url_Document        -> "URL document"
  --
  NodeFile            -> "File"
335
  Calc                -> "Calc"
336
  NodeFrameNotebook   -> "Notebook"
337
  Notes               -> "Notes"
338
  NodeFrameVisio      -> "Visio"
339
  NodePublic n        -> translateEN n
340 341

------------------------------------------------------
342

arturo's avatar
arturo committed
343
-- @NOTE: #379 deprecate the idea of circle/non-circle icons
344 345 346
getIcon :: NodeType -> Boolean -> String
getIcon NodeUser false = "user-circle"
getIcon NodeUser true  = "user"
347
------------------------------------------------------
348 349
getIcon Folder  false  = "folder"
getIcon Folder  true   = "folder-open-o"
350
------------------------------------------------------
351 352
getIcon FolderPrivate true  = "lock"
getIcon FolderPrivate false = "lock-circle"
353

354 355 356 357
getIcon FolderShared  true  = "share-alt"
getIcon FolderShared  false = "share-circle"
getIcon Team  true   = "users"
getIcon Team  false  = "users-closed"
358

359
getIcon FolderPublic true  = "globe"
360
getIcon FolderPublic false = "globe"
361
------------------------------------------------------
362

363 364
getIcon Corpus true  = "book"
getIcon Corpus false = "book-circle"
365

366
getIcon Phylo _ = "code-fork"
367

368
getIcon Graph _ = "hubzilla"
369
getIcon NodeTexts _ = "newspaper-o"
370 371 372
getIcon Dashboard _ = "signal"
getIcon NodeList _ = "list"
getIcon NodeFile _ = "file"  -- TODO depending on mime type we can use fa-file-image etc
373

374 375
getIcon Annuaire true  = "address-card-o"
getIcon Annuaire false = "address-card"
376

377 378
getIcon NodeContact true  = "address-card-o"
getIcon NodeContact false = "address-card"
379

380 381
getIcon Notes true  = "file-text-o"
getIcon Notes false = "file-text"
382

383 384
getIcon Calc true  = "calculator"
getIcon Calc false = "calculator"
385

386 387
getIcon NodeFrameNotebook true  = "file-code-o"
getIcon NodeFrameNotebook false = "code"
388

389 390
getIcon NodeFrameVisio true  = "video-camera"
getIcon NodeFrameVisio false = "video-camera"
391

392

393
getIcon (NodePublic nt) b   = getIcon nt b
394

395 396
getIcon _        true   = "folder-open"
getIcon _        false  = "folder-o"
397

398 399 400
------------------------------------------------------

fldr :: NodeType -> Boolean -> String
401
fldr nt flag = classNamePrefix <> getIcon nt flag
402

403
charCodeIcon :: NodeType -> Boolean -> String
404
charCodeIcon nt flag = glyphiconToCharCode $ getIcon nt flag
405

406 407 408
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt              = NodePublic nt
409

410 411 412 413
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic   = true
isPublic _              = false
414

415 416
{-
------------------------------------------------------------
417
instance Ord NodeType where
418 419
  compare n1 n2 = compare (show n1) (show n2)

420
instance Eq NodeType where
421 422 423 424
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
nodeTypePath :: NodeType -> String
425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445
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 Context           = "context"
nodeTypePath NodeUser          = "user"
nodeTypePath NodeContact       = "contact"
nodeTypePath Tree              = "tree"
nodeTypePath NodeList          = "lists"
nodeTypePath NodeTexts         = "texts"
nodeTypePath Team              = "team"
446
nodeTypePath Notes    = "write"
447
nodeTypePath Calc     = "calc"
448 449
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath NodeFrameVisio    = "visio"
450 451
nodeTypePath (NodePublic nt)   = nodeTypePath nt
nodeTypePath NodeFile          = "file"
452

453
------------------------------------------------------------
454 455 456 457 458
type CorpusId   = Int
type DocId      = Int
type ListId     = Int
type AnnuaireId = Int
type ContactId  = Int
459

460 461
data ScoreType = Occurrences

462
derive instance Generic ScoreType _
463 464
instance Eq ScoreType where eq = genericEq
instance Show ScoreType where show = genericShow
465

466 467
type SearchQuery = String

468
type NgramsGetOpts =
469 470
  { limit          :: Limit
  , listIds        :: Array ListId
471
  , offset         :: Maybe Offset
472
  , orderBy        :: Maybe OrderBy
473 474
  , searchQuery    :: SearchQuery
  , tabType        :: TabType
475 476 477 478
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  }

479
type NgramsGetTableAllOpts =
480 481
  { listIds        :: Array ListId
  , tabType        :: TabType
482 483
  }

484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
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
502
  , limit     :: Maybe Limit
503
  , listId    :: Maybe ListId
504 505 506
  , tabType   :: TabType
  }

James Laver's avatar
James Laver committed
507
data NodePath = NodePath SessionId NodeType (Maybe Id)
508 509

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

513
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
514

515
instance Show ChartType
516
  where
517 518 519 520
    show Histo     = "chart"
    show Scatter   = "scatter"
    show ChartBar  = "bar"
    show ChartPie  = "pie"
521 522
    show ChartTree = "tree"

523 524 525 526 527 528 529 530
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

531 532 533 534 535 536 537 538 539
type Id  = Int
type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

540
derive instance Generic OrderBy _
541 542 543
instance Show OrderBy where show = genericShow
instance JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
544 545

------------------------------------------------------------
546 547 548
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11

549
derive instance Generic ApiVersion _
550 551 552 553
instance JSON.ReadForeign ApiVersion where
  readImpl f = do
    s <- JSON.readImpl f
    case s of
554
      "v0"   -> pure V0
555 556
      "v1.0" -> pure V10
      "v1.1" -> pure V11
557
      x      -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
558
instance JSON.WriteForeign ApiVersion where
559
  writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
560
instance Show ApiVersion where
561
  show V0  = "v0"
562 563
  show V10 = "v1.0"
  show V11 = "v1.1"
564
instance Eq ApiVersion where
565 566 567
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false
568 569
------------------------------------------------------------

570 571
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
572
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
573
derive instance Generic CTabNgramType _
574 575 576
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
577 578 579 580
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"
581 582 583 584 585 586 587
instance Read CTabNgramType where
  read "Terms"     = Just CTabTerms
  read "Sources"   = Just CTabSources
  read "Authors"   = Just CTabAuthors
  read "Institutes" = Just CTabInstitutes
  read _            = Nothing
instance JSON.ReadForeign  CTabNgramType where readImpl = JSONG.enumSumRep
588
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
589 590

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
591 592 593
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
594
instance Show PTabNgramType where
595 596 597
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
598
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
599 600

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
601 602 603 604 605 606 607 608 609 610 611 612 613 614
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) }
615
{-
616
instance DecodeJson a => DecodeJson (TabSubType a) where
617 618 619 620 621 622 623 624 625 626 627
  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 <> "'") -}
628

629
instance Show a => Show (TabSubType a) where
630 631 632 633 634 635 636 637 638
  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)
639
  | TabDocument (TabSubType CTabNgramType)
640

641 642 643
derive instance Generic TabType _
derive instance Eq TabType
derive instance Ord TabType
644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662
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
663 664
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
665
instance DecodeJson TabType where
666 667 668 669 670 671 672 673 674
  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 <> "'") -}
675 676 677

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

680 681 682 683
data Mode = Authors
          | Sources
          | Institutes
          | Terms
684

685
derive instance Generic Mode _
686 687 688 689
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
690

691 692 693
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
694
modeTabType Sources    = CTabSources
695 696 697
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
698
modeFromString "Authors"    = Just Authors
699
modeFromString "Institutes" = Just Institutes
700
modeFromString "Sources"    = Just Sources
701 702
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
703

704 705 706
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
707
data AsyncTaskType = AddNode
708
                   | CorpusFormUpload  -- this is file upload too
709
                   | GraphRecompute
710
                   | ListUpload
711
                   | ListCSVUpload  -- legacy v3 CSV upload for lists
arturo's avatar
arturo committed
712
                   | NodeDocument
713
                   | Query
714
                   | UpdateNgramsCharts
715
                   | UpdateNode
716
                   | UploadFile
717
                   | UploadFrameCalc
718

719 720 721 722
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
  readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
723
  eq = genericEq
724
instance Show AsyncTaskType where
725
  show = genericShow
726 727

asyncTaskTypePath :: AsyncTaskType -> String
728
asyncTaskTypePath AddNode            = "async/nobody/"
729
asyncTaskTypePath CorpusFormUpload   = "add/form/async/"
730
asyncTaskTypePath GraphRecompute     = "async/recompute/"
731 732
asyncTaskTypePath ListUpload         = "add/form/async/"
asyncTaskTypePath ListCSVUpload      = "csv/add/form/async/"
arturo's avatar
arturo committed
733
asyncTaskTypePath NodeDocument       = "document/upload/async"
734
asyncTaskTypePath Query              = "query/"
735
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
736 737
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
738
asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
739

740

741 742
type AsyncTaskID = String

743 744 745 746 747 748 749 750 751 752 753
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
754
  show = genericShow
755 756 757 758 759 760 761 762 763 764
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
765

766 767 768 769 770
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

771 772 773
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
774
instance Eq AsyncTask where eq = genericEq
775

776 777
newtype AsyncTaskWithType = AsyncTaskWithType
  { task :: AsyncTask
778 779
  , typ  :: AsyncTaskType
  }
780 781 782
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
783
instance Eq AsyncTaskWithType where eq = genericEq
784

785
newtype AsyncProgress = AsyncProgress
786 787 788
  { id     :: AsyncTaskID
  , error  :: Maybe String
  , log    :: Array AsyncTaskLog
789 790
  , status :: AsyncTaskStatus
  }
791 792 793
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
794

795 796 797 798 799 800 801 802 803 804
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
805 806 807 808
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
809 810 811
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
812 813

progressPercent :: AsyncProgress -> Number
814
progressPercent (AsyncProgress { log }) = perc
815
  where
816 817 818
    perc = case A.head log of
      Nothing -> 0.0
      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
819
        where
820 821
          nom = toNumber $ failed + succeeded
          denom = toNumber $ failed + succeeded + remaining
822 823 824 825

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

826
---------------------------------------------------------------------------
827

828
data SidePanelState = InitialClosed | Opened | Closed
829
derive instance Generic SidePanelState _
830
instance Eq SidePanelState where eq = genericEq
831

832 833 834 835
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed
836 837 838

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

839 840 841
data FrontendError =
    FStringError { error :: String }
  | FRESTError { error :: RESTError }
842
  | FOtherError { error :: String }
843 844 845

derive instance Generic FrontendError _
instance Eq FrontendError where eq = genericEq
846 847 848 849 850

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

newtype CacheParams = CacheParams
  { expandTableEdition    :: Boolean
851
  , showTree              :: Boolean
852 853 854 855 856 857 858 859 860 861 862 863 864 865 866
  }

derive instance Newtype CacheParams _
derive instance Generic CacheParams _
derive instance Eq CacheParams
instance Show CacheParams where show = genericShow
derive newtype instance JSON.ReadForeign CacheParams
derive newtype instance JSON.WriteForeign CacheParams

-- (!) in case cache storage (ie. JavaScript Local Storage) returns an invalid
--     objects (eg. possible data migration), this will safely set new default
--     values
defaultCacheParams :: CacheParams
defaultCacheParams = CacheParams
  { expandTableEdition    : false
867
  , showTree              : true
868
  }