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

3
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
4
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
5
import Data.Array as A
6
import Data.Either (Either(..))
7
import Data.String as S
8 9 10 11
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
12
import Data.Int (toNumber)
13
import Data.Maybe (Maybe(..), maybe, fromMaybe)
14
import Effect.Aff (Aff)
15
import Prim.Row (class Union)
16
import Reactix as R
James Laver's avatar
James Laver committed
17
import URI.Query (Query)
18

19 20
import Gargantext.Prelude

21 22
data Handed = LeftHanded | RightHanded

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

27 28 29
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
30 31 32 33 34 35

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

derive instance ed :: Generic Handed _
36 37 38
instance eqHanded :: Eq Handed where
  eq = genericEq

James Laver's avatar
James Laver committed
39

40 41
type ID      = Int
type Name    = String
42

43
newtype SessionId = SessionId String
44
type NodeID = Int
45 46 47 48 49 50 51 52 53

derive instance genericSessionId :: Generic SessionId _

instance eqSessionId :: Eq SessionId where
  eq = genericEq

instance showSessionId :: Show SessionId where
  show (SessionId s) = s

54
data TermSize = MonoTerm | MultiTerm
55

56 57
data Term = Term String TermList

58
derive instance eqTermSize :: Eq TermSize
59

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

64
instance showTermSize :: Show TermSize where
65 66 67
  show MonoTerm  = "MonoTerm"
  show MultiTerm = "MultiTerm"

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

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

80
data TermList = MapTerm | StopTerm | CandidateTerm
81
-- TODO use generic JSON instance
82 83

derive instance eqTermList :: Eq TermList
84
derive instance ordTermList :: Ord TermList
85

86
instance encodeJsonTermList :: EncodeJson TermList where
87
  encodeJson MapTerm       = encodeJson "MapTerm"
88 89
  encodeJson StopTerm      = encodeJson "StopTerm"
  encodeJson CandidateTerm = encodeJson "CandidateTerm"
90

91
instance decodeJsonTermList :: DecodeJson TermList where
92 93 94
  decodeJson json = do
    s <- decodeJson json
    case s of
95
      "MapTerm"       -> pure MapTerm
96 97
      "StopTerm"      -> pure StopTerm
      "CandidateTerm" -> pure CandidateTerm
James Laver's avatar
James Laver committed
98
      s'              -> Left (AtKey s' $ TypeMismatch "Unexpected list name")
99 100

instance showTermList :: Show TermList where
101
  show MapTerm       = "MapTerm"
102 103
  show StopTerm      = "StopTerm"
  show CandidateTerm = "CandidateTerm"
104

105 106
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
107
termListName MapTerm = "Map List"
108 109 110
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"

111 112
instance readTermList :: Read TermList where
  read :: String -> Maybe TermList
113
  read "MapTerm"     = Just MapTerm
114 115 116
  read "StopTerm"      = Just StopTerm
  read "CandidateTerm" = Just CandidateTerm
  read _               = Nothing
117 118 119

termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms",   mval: Nothing      }
120
            , { desc: "Map terms",   mval: Just MapTerm   }
121 122 123 124
            , { desc: "Stop terms",  mval: Just StopTerm  }
            , { desc: "Candidate terms", mval: Just CandidateTerm }
            ]

125 126 127
-- | Proof that row `r` is a subset of row `s`
class Optional (r :: # Type) (s :: # Type)
instance optionalInstance :: Union r t s => Optional r s
128 129 130 131

showTabType' :: TabType -> String
showTabType' (TabCorpus   t) = show t
showTabType' (TabDocument t) = show t
132
showTabType' (TabPairing  t) = show t
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150

data TabPostQuery = TabPostQuery {
    offset :: Int
  , limit :: Int
  , orderBy :: OrderBy
  , tabType :: TabType
  , query :: String
  }

instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
  encodeJson (TabPostQuery post) =
        "view"       := showTabType' post.tabType
     ~> "offset"     := post.offset
     ~> "limit"      := post.limit
     ~> "orderBy"    := show post.orderBy
     ~> "query"      := post.query
     ~> jsonEmptyObject

151
data NodeType = Annuaire
152 153 154
              | Corpus
              | Dashboard
              | Error
155 156 157 158
              | Folder
              | FolderPrivate
              | FolderPublic
              | FolderShared
159 160 161
              | Graph
              | Individu
              | Node
162
              | NodeContact
163
              | NodeList
164 165 166 167
              | NodeUser
              | Nodes
              | Phylo
              | Team
168
              | Texts
169 170
              | Tree
              | Url_Document
171
              -- TODO Optional Nodes
172
              | NodeFile
173
              | NodeFrameCalc
174
              | NodeFrameNotebook
175
              | NodeFrameWrite
176 177
              | NodePublic NodeType

178 179 180 181

derive instance eqNodeType :: Eq NodeType

instance showNodeType :: Show NodeType where
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
  show NodeUser        = "NodeUser"

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

  show Annuaire        = "NodeAnnuaire"
  show NodeContact     = "NodeContact"
  show Corpus          = "NodeCorpus"
  show Dashboard       = "NodeDashboard"
  show Url_Document    = "NodeDocument"
  show Error           = "NodeError"
  show Graph           = "NodeGraph"
  show Phylo           = "NodePhylo"
  show Individu        = "NodeIndividu"
  show Node            = "Node"
  show Nodes           = "Nodes"
  show Tree            = "NodeTree"
  show Team            = "NodeTeam"
  show NodeList        = "NodeList"
203
  show Texts           = "NodeDocs"
204 205
  show NodeFrameWrite  = "NodeFrameWrite"
  show NodeFrameCalc   = "NodeFrameCalc"
206
  show NodeFrameNotebook   = "NodeFrameNotebook"
207
  show (NodePublic nt) = "NodePublic" <> show nt
208
  show NodeFile        = "NodeFile"
209

210

211 212 213 214 215 216
instance readNodeType :: Read NodeType where
  read "NodeUser"          = Just NodeUser
  read "NodeFolder"        = Just Folder
  read "NodeFolderPrivate" = Just FolderPrivate
  read "NodeFolderShared"  = Just FolderShared
  read "NodeFolderPublic"  = Just FolderPublic
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
  read "NodeAnnuaire"      = Just Annuaire
  read "NodeDashboard"     = Just Dashboard
  read "Document"          = Just Url_Document
  read "NodeGraph"         = Just Graph
  read "NodePhylo"         = Just Phylo
  read "Individu"          = Just Individu
  read "Node"              = Just Node
  read "Nodes"             = Just Nodes
  read "NodeCorpus"        = Just Corpus
  read "NodeContact"       = Just NodeContact
  read "Tree"              = Just Tree
  read "NodeTeam"          = Just Team
  read "NodeList"          = Just NodeList
  read "NodeTexts"         = Just Texts
  read "Annuaire"          = Just Annuaire
  read "NodeFrameWrite"    = Just NodeFrameWrite
  read "NodeFrameCalc"     = Just NodeFrameCalc
234
  read "NodeFrameNotebook"     = Just NodeFrameNotebook
235
  read "NodeFile"          = Just NodeFile
236
  -- TODO NodePublic read ?
237
  read _                   = Nothing
238 239 240 241


fldr :: NodeType -> Boolean -> String
fldr NodeUser false = "fa fa-user-circle"
242 243
fldr NodeUser true  = "fa fa-user"
------------------------------------------------------
244 245
fldr Folder  false  = "fa fa-folder"
fldr Folder  true   = "fa fa-folder-open-o"
246
------------------------------------------------------
247
fldr FolderPrivate true  = "fa fa-lock"
248
fldr FolderPrivate false = "fa fa-lock-circle"
249

250
fldr FolderShared  true  = "fa fa-share-alt"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
251
fldr FolderShared  false = "fa fa-share-circle"
252
fldr Team  true   = "fa fa-users"
253
fldr Team  false  = "fa fa-users-closed"
254

255 256
fldr FolderPublic true  = "fa fa-globe-circle"
fldr FolderPublic false = "fa fa-globe"
257
------------------------------------------------------
258

259
fldr Corpus true  = "fa fa-book"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
260
fldr Corpus false = "fa fa-book-circle"
261 262 263 264 265 266 267

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

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

270 271
fldr Annuaire true  = "fa fa-address-card-o"
fldr Annuaire false = "fa fa-address-card"
272 273 274 275

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

276
fldr NodeFrameWrite true  = "fa fa-file-text-o"
277
fldr NodeFrameWrite false = "fa fa-file-text"
278

279 280
fldr NodeFrameCalc true  = "fa fa-calculator"
fldr NodeFrameCalc false = "fa fa-calculator"
281

282 283
fldr NodeFrameNotebook true  = "fa fa-file-code-o"
fldr NodeFrameNotebook false = "fa fa-code"
284 285


286
fldr (NodePublic nt) b   = fldr nt b
287

288
fldr _        true   = "fa fa-folder-open"
289
fldr _        false  = "fa fa-folder-o"
290 291


292 293 294
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt              = NodePublic nt
295

296 297 298 299
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic   = true
isPublic _              = false
300

301 302 303 304 305 306 307 308 309 310 311 312
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
  compare n1 n2 = compare (show n1) (show n2)

instance eqNodeType :: Eq NodeType where
  eq n1 n2  = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
  decodeJson json = do
    obj <- decodeJson json
313
    pure $ fromMaybe Error $ read obj
314 315 316 317 318

instance encodeJsonNodeType :: EncodeJson NodeType where
  encodeJson nodeType = encodeJson $ show nodeType

nodeTypePath :: NodeType -> String
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340
nodeTypePath Folder          = "folder"
nodeTypePath FolderPrivate   = "folderPrivate"
nodeTypePath FolderShared    = "folderShared"
nodeTypePath FolderPublic    = "folderPublic"
nodeTypePath Annuaire        = "annuaire"
nodeTypePath Corpus          = "corpus"
nodeTypePath Dashboard       = "dashboard"
nodeTypePath Url_Document    = "document"
nodeTypePath Error           = "ErrorNodeType"
nodeTypePath Graph           = "graph"
nodeTypePath Phylo           = "phylo"
nodeTypePath Individu        = "individu"
nodeTypePath Node            = "node"
nodeTypePath Nodes           = "nodes"
nodeTypePath NodeUser        = "user"
nodeTypePath NodeContact     = "contact"
nodeTypePath Tree            = "tree"
nodeTypePath NodeList        = "lists"
nodeTypePath Texts           = "texts"
nodeTypePath Team            = "team"
nodeTypePath NodeFrameWrite  = "write"
nodeTypePath NodeFrameCalc   = "calc"
341
nodeTypePath NodeFrameNotebook   = "code"
342
nodeTypePath (NodePublic nt) = nodeTypePath nt
343
nodeTypePath NodeFile        = "file"
344

345
------------------------------------------------------------
346 347 348 349 350
type CorpusId   = Int
type DocId      = Int
type ListId     = Int
type AnnuaireId = Int
type ContactId  = Int
351

352 353 354
data ScoreType = Occurrences

derive instance genericScoreType :: Generic ScoreType _
355 356
instance eqScoreType :: Eq ScoreType where
  eq = genericEq
357 358 359
instance showScoreType :: Show ScoreType where
  show = genericShow

360 361
type SearchQuery = String

362
type NgramsGetOpts =
363 364
  { limit          :: Limit
  , listIds        :: Array ListId
365
  , offset         :: Maybe Offset
366
  , orderBy        :: Maybe OrderBy
367 368
  , searchQuery    :: SearchQuery
  , tabType        :: TabType
369 370 371 372
  , termListFilter :: Maybe TermList
  , termSizeFilter :: Maybe TermSize
  }

373
type NgramsGetTableAllOpts =
374 375
  { listIds        :: Array ListId
  , tabType        :: TabType
376 377
  }

378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
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
396
  , limit     :: Maybe Limit
397
  , listId    :: Maybe ListId
398 399 400
  , tabType   :: TabType
  }

James Laver's avatar
James Laver committed
401
data NodePath = NodePath SessionId NodeType (Maybe Id)
402 403

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

407
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
408 409 410

instance showChartType :: Show ChartType
  where
411 412 413 414
    show Histo     = "chart"
    show Scatter   = "scatter"
    show ChartBar  = "bar"
    show ChartPie  = "pie"
415 416
    show ChartTree = "tree"

417 418 419 420 421 422 423 424
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

425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
type Id  = Int
type Limit  = Int
type Offset = Int
data OrderBy = DateAsc  | DateDesc
             | TitleAsc | TitleDesc
             | ScoreAsc | ScoreDesc
             | TermAsc  | TermDesc
             | SourceAsc | SourceDesc

derive instance genericOrderBy :: Generic OrderBy _

instance showOrderBy :: Show OrderBy where
  show = genericShow

------------------------------------------------------------
440 441 442
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11

443
instance showApiVersion :: Show ApiVersion where
444
  show V0  = "v0"
445 446 447 448 449 450 451 452
  show V10 = "v1.0"
  show V11 = "v1.1"

instance eqApiVersion :: Eq ApiVersion where
  eq V10 V10 = true
  eq V11 V11 = true
  eq _ _ = false

453 454 455 456 457 458 459 460 461 462 463 464
instance encodeJsonApiVersion :: EncodeJson ApiVersion where
  encodeJson v = encodeJson (show v)

instance decodeJsonApiVersion :: DecodeJson ApiVersion where
  decodeJson json = do
    v <- decodeJson json
    case v of
         "v1.0" -> pure V10
         "v1.1" -> pure V11
         _      -> pure V0
------------------------------------------------------------

465 466
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
467 468 469
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes

derive instance eqCTabNgramType :: Eq CTabNgramType
470
derive instance ordCTabNgramType :: Ord CTabNgramType
471 472 473 474 475
instance showCTabNgramType :: Show CTabNgramType where
  show CTabTerms      = "Terms"
  show CTabSources    = "Sources"
  show CTabAuthors    = "Authors"
  show CTabInstitutes = "Institutes"
476 477
instance encodeCTabNgramType :: EncodeJson CTabNgramType where
  encodeJson t = encodeJson $ show t
478 479 480 481

data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication

derive instance eqPTabNgramType :: Eq PTabNgramType
482
derive instance ordPTabNgramType :: Ord PTabNgramType
483 484 485 486
instance showPTabNgramType :: Show PTabNgramType where
  show PTabPatents       = "Patents"
  show PTabBooks         = "Books"
  show PTabCommunication = "Communication"
487 488
instance encodePTabNgramType :: EncodeJson PTabNgramType where
  encodeJson t = encodeJson $ show t
489 490 491 492

data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash

derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
493
derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
494
instance encodeTabSubType :: EncodeJson a => EncodeJson (TabSubType a) where
495 496
  encodeJson TabDocs =
       "type" := "TabDocs"
497
    ~> "data" := (Nothing :: Maybe String)
498 499 500 501 502 503 504
    ~> jsonEmptyObject
  encodeJson (TabNgramType a) =
       "type" := "TabNgramType"
    ~> "data" := encodeJson a
    ~> jsonEmptyObject
  encodeJson TabTrash =
       "type" := "TabTrash"
505
    ~> "data" := (Nothing :: Maybe String)
506 507 508
    ~> jsonEmptyObject
  encodeJson TabMoreLikeFav =
       "type" := "TabMoreLikeFav"
509
    ~> "data" := (Nothing :: Maybe String)
510 511 512
    ~> jsonEmptyObject
  encodeJson TabMoreLikeTrash =
       "type" := "TabMoreLikeTrash"
513
    ~> "data" := (Nothing :: Maybe String)
514
    ~> jsonEmptyObject
515
{-
516 517 518 519 520 521 522 523 524 525 526 527
instance decodeTabSubType a :: DecodeJson a => DecodeJson (TabSubType a) where
  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 <> "'") -}
528 529 530 531 532 533 534 535 536 537 538

instance showTabSubType :: Show a => Show (TabSubType a) where
  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)
539
  | TabDocument (TabSubType CTabNgramType)
540

541
derive instance genericTabType :: Generic TabType _
542
derive instance eqTabType :: Eq TabType
543
derive instance ordTabType :: Ord TabType
544 545
instance showTabType :: Show TabType where
  show = genericShow
546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565
instance encodeTabType :: EncodeJson TabType where
  encodeJson (TabCorpus TabDocs)                         = encodeJson "Docs"
  encodeJson (TabCorpus (TabNgramType CTabAuthors))      = encodeJson "Authors"
  encodeJson (TabCorpus (TabNgramType CTabInstitutes))   = encodeJson "Institutes"
  encodeJson (TabCorpus (TabNgramType CTabSources))      = encodeJson "Sources"
  encodeJson (TabCorpus (TabNgramType CTabTerms))        = encodeJson "Terms"
  encodeJson (TabCorpus TabMoreLikeFav)                  = encodeJson "MoreFav"
  encodeJson (TabCorpus TabMoreLikeTrash)                = encodeJson "MoreTrash"
  encodeJson (TabCorpus TabTrash)                        = encodeJson "Trash"
  encodeJson (TabDocument TabDocs)                       = encodeJson "Docs"
  encodeJson (TabDocument (TabNgramType CTabAuthors))    = encodeJson "Authors"
  encodeJson (TabDocument (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
  encodeJson (TabDocument (TabNgramType CTabSources))    = encodeJson "Sources"
  encodeJson (TabDocument (TabNgramType CTabTerms))      = encodeJson "Terms"
  encodeJson (TabDocument TabMoreLikeFav)                = encodeJson "MoreFav"
  encodeJson (TabDocument TabMoreLikeTrash)              = encodeJson "MoreTrash"
  encodeJson (TabDocument TabTrash)                      = encodeJson "Trash"
  encodeJson (TabPairing d)                              = encodeJson "TabPairing"  -- TODO
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
566 567 568 569 570 571 572 573 574 575
instance decodeTabType :: DecodeJson TabType where
  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 <> "'") -}
576 577 578

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

580 581 582 583
data Mode = Authors
          | Sources
          | Institutes
          | Terms
584 585 586 587 588 589 590

derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
  show = genericShow
derive instance eqMode :: Eq Mode
instance ordMode :: Ord Mode where
  compare = genericCompare
591 592 593
instance encodeMode :: EncodeJson Mode where
  encodeJson x = encodeJson $ show x

594 595 596
modeTabType :: Mode -> CTabNgramType
modeTabType Authors    = CTabAuthors
modeTabType Institutes = CTabInstitutes
597
modeTabType Sources    = CTabSources
598 599 600
modeTabType Terms      = CTabTerms

modeFromString :: String -> Maybe Mode
601
modeFromString "Authors"    = Just Authors
602
modeFromString "Institutes" = Just Institutes
603
modeFromString "Sources"    = Just Sources
604 605
modeFromString "Terms"      = Just Terms
modeFromString _            = Nothing
606

607 608 609
-- Async tasks

-- corresponds to /add/form/async or /add/query/async
610
data AsyncTaskType = AddNode
611
                   | Form  -- this is file upload too
612
                   | GraphRecompute
613
                   | Query
614
                   | UpdateNgramsCharts
615
                   | UpdateNode
616
                   | UploadFile
617

618
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
619 620 621 622 623 624
instance eqAsyncTaskType :: Eq AsyncTaskType where
  eq = genericEq
instance showAsyncTaskType :: Show AsyncTaskType where
  show = genericShow
instance encodeJsonAsyncTaskType :: EncodeJson AsyncTaskType where
  encodeJson t     = encodeJson $ show t
625 626 627 628
instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
  decodeJson json = do
    obj <- decodeJson json
    case obj of
629 630 631 632 633 634 635 636
      "AddNode"            -> pure AddNode
      "Form"               -> pure Form
      "GraphRecompute"     -> pure GraphRecompute
      "Query"              -> pure Query
      "UpdateNgramsCharts" -> pure UpdateNgramsCharts
      "UpdateNode"         -> pure UpdateNode
      "UploadFile"         -> pure UploadFile
      s                    -> Left $ AtKey s $ TypeMismatch "Unknown string"
637 638

asyncTaskTypePath :: AsyncTaskType -> String
639 640 641 642
asyncTaskTypePath AddNode            = "async/nobody/"
asyncTaskTypePath Form               = "add/form/async/"
asyncTaskTypePath GraphRecompute     = "async/recompute/"
asyncTaskTypePath Query              = "query/"
643
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
644 645
asyncTaskTypePath UpdateNode         = "update/"
asyncTaskTypePath UploadFile         = "async/file/add/"
646

647

648 649
type AsyncTaskID = String

650 651 652 653 654 655 656
data AsyncTaskStatus = Running
                     | Pending
                     | Received
                     | Started
                     | Failed
                     | Finished
                     | Killed
657
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
658

659 660
instance showAsyncTaskStatus :: Show AsyncTaskStatus where
  show = genericShow
661
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
662

663 664
instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where
  encodeJson s = encodeJson $ show s
665

666 667 668
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
  decodeJson json = do
    obj <- decodeJson json
669 670 671 672 673 674 675 676 677 678 679
    pure $ fromMaybe Running $ read obj

instance readAsyncTaskStatus :: 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
680

681 682 683 684 685
newtype AsyncTask =
  AsyncTask { id     :: AsyncTaskID
            , status :: AsyncTaskStatus
            }

686
derive instance genericAsyncTask :: Generic AsyncTask _
687 688 689 690 691 692 693
instance eqAsyncTask :: Eq AsyncTask where
  eq = genericEq
instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
  encodeJson (AsyncTask { id, status }) =
        "id"       := id
     ~> "status"   := status
     ~> jsonEmptyObject
694 695
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
  decodeJson json = do
696 697
    obj    <- decodeJson json
    id     <- obj .: "id"
698
    status <- obj .: "status"
699
    pure $ AsyncTask { id, status }
700 701 702 703 704

newtype AsyncTaskWithType = AsyncTaskWithType {
    task :: AsyncTask
  , typ  :: AsyncTaskType
  }
705 706 707 708 709 710 711 712
derive instance genericAsyncTaskWithType :: Generic AsyncTaskWithType _
instance eqAsyncTaskWithType :: Eq AsyncTaskWithType where
  eq = genericEq
instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
  encodeJson (AsyncTaskWithType { task, typ }) =
        "task"       := task
     ~> "typ"        := typ
     ~> jsonEmptyObject
713 714
instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
  decodeJson json = do
715
    obj  <- decodeJson json
716
    task <- obj .: "task"
717
    typ  <- obj .: "typ"
718 719
    pure $ AsyncTaskWithType { task, typ }

720 721 722 723 724 725 726 727
newtype AsyncProgress = AsyncProgress {
    id :: AsyncTaskID
  , log :: Array AsyncTaskLog
  , status :: AsyncTaskStatus
  }
derive instance genericAsyncProgress :: Generic AsyncProgress _
instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
  decodeJson json = do
728 729 730
    obj    <- decodeJson json
    id     <- obj .: "id"
    log    <- obj .: "log"
731 732 733 734 735 736 737 738 739 740 741 742
    status <- obj .: "status"
    pure $ AsyncProgress {id, log, status}

newtype AsyncTaskLog = AsyncTaskLog {
    events :: Array String
  , failed :: Int
  , remaining :: Int
  , succeeded :: Int
  }
derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
  decodeJson json = do
743 744 745
    obj       <- decodeJson json
    events    <- obj .: "events"
    failed    <- obj .: "failed"
746 747 748 749 750
    remaining <- obj .: "remaining"
    succeeded <- obj .: "succeeded"
    pure $ AsyncTaskLog {events, failed, remaining, succeeded}

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

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

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

768
---------------------------------------------------------------------------
769

770 771 772 773
data SidePanelState = InitialClosed | Opened | Closed
derive instance genericSidePanelState :: Generic SidePanelState _
instance eqSidePanelState :: Eq SidePanelState where
  eq = genericEq
774

775 776 777 778
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed        = Opened
toggleSidePanelState Opened        = Closed