Types.purs 27.9 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 195 196 197 198 199 200 201
  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"
  show NodeFrameWrite    = "NodeFrameWrite"
  show NodeFrameCalc     = "NodeFrameCalc"
202 203
  show NodeFrameNotebook = "NodeFrameNotebook"
  show NodeFrameVisio    = "NodeFrameVisio"
204 205
  show (NodePublic nt)   = "NodePublic" <> show nt
  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
getIcon FolderPublic true  = "globe"
326
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
getIcon (NodePublic nt) b   = getIcon nt b
360

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

364 365 366
------------------------------------------------------

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

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

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

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

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

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

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

426 427
data ScoreType = Occurrences

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

432 433
type SearchQuery = String

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

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

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

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

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

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

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

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

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

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

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

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

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

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
557 558 559
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
560
instance Show PTabNgramType where
561 562 563
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
564
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
565 566

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

595
instance Show a => Show (TabSubType a) where
596 597 598 599 600 601 602 603 604
  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)
605
  | TabDocument (TabSubType CTabNgramType)
606

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

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

646 647 648 649
data Mode = Authors
          | Sources
          | Institutes
          | Terms
650

651
derive instance Generic Mode _
652 653 654 655
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
656

657 658 659
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
660
modeTabType Sources    = CTabSources
661 662 663
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
664
modeFromString "Authors"    = Just Authors
665
modeFromString "Institutes" = Just Institutes
666
modeFromString "Sources"    = Just Sources
667 668
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
669

670 671 672
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
673
data AsyncTaskType = AddNode
674
                   | CorpusFormUpload  -- this is file upload too
675
                   | GraphRecompute
676
                   | ListUpload
677
                   | ListCSVUpload  -- legacy v3 CSV upload for lists
arturo's avatar
arturo committed
678
                   | NodeDocument
679
                   | Query
680
                   | UpdateNgramsCharts
681
                   | UpdateNode
682
                   | UploadFile
683
                   | UploadFrameCalc
684

685 686 687 688
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
  readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
689
  eq = genericEq
690
instance Show AsyncTaskType where
691
  show = genericShow
692 693

asyncTaskTypePath :: AsyncTaskType -> String
694
asyncTaskTypePath AddNode            = "async/nobody/"
695
asyncTaskTypePath CorpusFormUpload   = "add/form/async/"
696
asyncTaskTypePath GraphRecompute     = "async/recompute/"
697 698
asyncTaskTypePath ListUpload         = "add/form/async/"
asyncTaskTypePath ListCSVUpload      = "csv/add/form/async/"
arturo's avatar
arturo committed
699
asyncTaskTypePath NodeDocument       = "document/upload/async"
700
asyncTaskTypePath Query              = "query/"
701
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
702 703
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
704
asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
705

706

707 708
type AsyncTaskID = String

709 710 711 712 713 714 715 716 717 718 719
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
720
  show = genericShow
721 722 723 724 725 726 727 728 729 730
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
731

732 733 734 735 736
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

737 738 739
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
740
instance Eq AsyncTask where eq = genericEq
741

742 743
newtype AsyncTaskWithType = AsyncTaskWithType
  { task :: AsyncTask
744 745
  , typ  :: AsyncTaskType
  }
746 747 748
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
749
instance Eq AsyncTaskWithType where eq = genericEq
750

751
newtype AsyncProgress = AsyncProgress
752 753 754
  { id     :: AsyncTaskID
  , error  :: Maybe String
  , log    :: Array AsyncTaskLog
755 756
  , status :: AsyncTaskStatus
  }
757 758 759
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
760

761 762 763 764 765 766 767 768 769 770
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
771 772 773 774
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
775 776 777
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
778 779

progressPercent :: AsyncProgress -> Number
780
progressPercent (AsyncProgress { log }) = perc
781
  where
782 783 784
    perc = case A.head log of
      Nothing -> 0.0
      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
785
        where
786 787
          nom = toNumber $ failed + succeeded
          denom = toNumber $ failed + succeeded + remaining
788 789 790 791 792 793 794 795 796

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

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

797
---------------------------------------------------------------------------
798

799
data SidePanelState = InitialClosed | Opened | Closed
800
derive instance Generic SidePanelState _
801
instance Eq SidePanelState where eq = genericEq
802

803 804 805 806
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed
807 808 809

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

810 811 812
data FrontendError =
    FStringError { error :: String }
  | FRESTError { error :: RESTError }
813
  | FOtherError { error :: String }
814 815 816

derive instance Generic FrontendError _
instance Eq FrontendError where eq = genericEq
817 818 819 820 821

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

newtype CacheParams = CacheParams
  { expandTableEdition    :: Boolean
822
  , showTree              :: Boolean
823 824 825 826 827 828 829 830 831 832 833 834 835 836 837
  }

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
838
  , showTree              : true
839
  }