src/Gargantext/Database/Types/Node.hs

   1 {-|
   2 Module      : Gargantext.Database.Types.Nodes
   3 Description : Main Types of Nodes in Database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE BangPatterns               #-}
  15 {-# LANGUAGE DeriveGeneric              #-}
  16 {-# LANGUAGE FlexibleInstances          #-}
  17 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  18 {-# LANGUAGE NoImplicitPrelude          #-}
  19 {-# LANGUAGE OverloadedStrings          #-}
  20 {-# LANGUAGE TemplateHaskell            #-}
  21 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  22 -- {-# LANGUAGE DuplicateRecordFields #-}
  23
  24 module Gargantext.Database.Types.Node
  25   where
  26
  27 import Prelude (Enum, Bounded, minBound, maxBound)
  28
  29 import GHC.Generics (Generic)
  30
  31 import           Control.Lens hiding (elements, (&))
  32 import           Control.Applicative ((<*>))
  33 import           Control.Monad (mzero)
  34
  35 import           Data.Aeson
  36 import           Data.Aeson.Types (emptyObject)
  37 import           Data.Aeson (Object, toJSON)
  38 import           Data.Aeson.TH (deriveJSON)
  39 import           Data.ByteString.Lazy (ByteString)
  40 import           Data.Either
  41 import           Data.Eq (Eq)
  42 import           Data.Monoid (mempty)
  43 import           Data.Text (Text, unpack, pack)
  44 import           Data.Time (UTCTime)
  45 import           Data.Time.Segment (jour, timesAfter, Granularity(D))
  46 import           Data.Swagger
  47
  48 import           Text.Read (read)
  49 import           Text.Show (Show())
  50
  51 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
  52 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  53 import           Servant
  54
  55 import           Test.QuickCheck.Arbitrary
  56 import           Test.QuickCheck (elements)
  57
  58 import           Gargantext.Prelude
  59 import           Gargantext.Core.Utils.Prefix (unPrefix)
  60 import           Gargantext.Viz.Phylo (Phylo)
  61 --import Gargantext.Database.Utils
  62 ------------------------------------------------------------------------
  63 newtype NodeId = NodeId Int
  64   deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
  65
  66 instance ToField NodeId where
  67   toField (NodeId n) = toField n
  68
  69
  70 instance FromField NodeId where
  71   fromField field mdata = do
  72     n <- fromField field mdata
  73     if (n :: Int) > 0
  74        then return $ NodeId n
  75        else mzero
  76
  77 instance ToSchema NodeId
  78
  79 instance FromHttpApiData NodeId where
  80   parseUrlPiece n = pure $ NodeId $ (read . cs) n
  81
  82 instance ToParamSchema NodeId
  83 instance Arbitrary NodeId where
  84   arbitrary = NodeId <$> arbitrary
  85
  86 type ParentId = NodeId
  87 type CorpusId = NodeId
  88 type ListId   = NodeId
  89 type DocumentId = NodeId
  90 type DocId      = DocumentId -- todo: remove this
  91 type RootId   = NodeId
  92 type MasterCorpusId = CorpusId
  93 type UserCorpusId   = CorpusId
  94
  95 type GraphId  = NodeId
  96 type PhyloId  = NodeId
  97 type AnnuaireId = NodeId
  98 type ContactId  = NodeId
  99
 100 type UserId   = Int
 101 type MasterUserId = UserId
 102
 103 id2int :: NodeId -> Int
 104 id2int (NodeId n) = n
 105
 106
 107 type UTCTime' = UTCTime
 108
 109 instance Arbitrary UTCTime' where
 110     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
 111
 112 ------------------------------------------------------------------------
 113 data Status  = Status { status_failed    :: !Int
 114                       , status_succeeded :: !Int
 115                       , status_remaining :: !Int
 116                       } deriving (Show, Generic)
 117 $(deriveJSON (unPrefix "status_") ''Status)
 118
 119 instance Arbitrary Status where
 120   arbitrary = Status <$> arbitrary <*> arbitrary <*> arbitrary
 121
 122 ------------------------------------------------------------------------
 123 data StatusV3  = StatusV3 { statusV3_error  :: !(Maybe Text)
 124                           , statusV3_action :: !(Maybe Text)
 125                       } deriving (Show, Generic)
 126 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
 127 ------------------------------------------------------------------------
 128
 129 -- Only Hyperdata types should be member of this type class.
 130 class Hyperdata a
 131
 132 ------------------------------------------------------------------------
 133 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
 134                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
 135                                                , hyperdataDocumentV3_publication_second :: !(Maybe Int)
 136                                                , hyperdataDocumentV3_publication_minute :: !(Maybe Int)
 137                                                , hyperdataDocumentV3_publication_month  :: !(Maybe Int)
 138                                                , hyperdataDocumentV3_publication_hour   :: !(Maybe Int)
 139                                                , hyperdataDocumentV3_error              :: !(Maybe Text)
 140                                                , hyperdataDocumentV3_language_iso3      :: !(Maybe Text)
 141                                                , hyperdataDocumentV3_authors            :: !(Maybe Text)
 142                                                , hyperdataDocumentV3_publication_year   :: !(Maybe Int)
 143                                                , hyperdataDocumentV3_publication_date   :: !(Maybe Text)
 144                                                , hyperdataDocumentV3_language_name      :: !(Maybe Text)
 145                                                , hyperdataDocumentV3_statuses           :: !(Maybe [StatusV3])
 146                                                , hyperdataDocumentV3_realdate_full_     :: !(Maybe Text)
 147                                                , hyperdataDocumentV3_source             :: !(Maybe Text)
 148                                                , hyperdataDocumentV3_abstract           :: !(Maybe Text)
 149                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
 150                                                } deriving (Show, Generic)
 151 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 152
 153 instance Hyperdata HyperdataDocumentV3
 154
 155 ------------------------------------------------------------------------
 156 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: !(Maybe Text)
 157                                            , _hyperdataDocument_doi                :: !(Maybe Text)
 158                                            , _hyperdataDocument_url                :: !(Maybe Text)
 159                                            , _hyperdataDocument_uniqId             :: !(Maybe Text)
 160                                            , _hyperdataDocument_uniqIdBdd          :: !(Maybe Text)
 161                                            , _hyperdataDocument_page               :: !(Maybe Int)
 162                                            , _hyperdataDocument_title              :: !(Maybe Text)
 163                                            , _hyperdataDocument_authors            :: !(Maybe Text)
 164                                            , _hyperdataDocument_institutes         :: !(Maybe Text)
 165                                            , _hyperdataDocument_source             :: !(Maybe Text)
 166                                            , _hyperdataDocument_abstract           :: !(Maybe Text)
 167                                            , _hyperdataDocument_publication_date   :: !(Maybe Text)
 168                                            , _hyperdataDocument_publication_year   :: !(Maybe Int)
 169                                            , _hyperdataDocument_publication_month  :: !(Maybe Int)
 170                                            , _hyperdataDocument_publication_day    :: !(Maybe Int)
 171                                            , _hyperdataDocument_publication_hour   :: !(Maybe Int)
 172                                            , _hyperdataDocument_publication_minute :: !(Maybe Int)
 173                                            , _hyperdataDocument_publication_second :: !(Maybe Int)
 174                                            , _hyperdataDocument_language_iso2      :: !(Maybe Text)
 175                                            } deriving (Show, Generic)
 176
 177 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 178 $(makeLenses ''HyperdataDocument)
 179
 180 class ToHyperdataDocument a where
 181   toHyperdataDocument :: a -> HyperdataDocument
 182
 183 instance ToHyperdataDocument HyperdataDocument
 184   where
 185     toHyperdataDocument = identity
 186
 187 instance Eq HyperdataDocument where
 188   (==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
 189
 190 instance Ord HyperdataDocument where
 191   compare h1 h2 = compare (_hyperdataDocument_publication_date h1) (_hyperdataDocument_publication_date h2)
 192
 193 instance Hyperdata HyperdataDocument
 194
 195 instance ToField HyperdataDocument where
 196   toField = toJSONField
 197
 198 instance Arbitrary HyperdataDocument where
 199     arbitrary = elements arbitraryHyperdataDocuments
 200
 201 arbitraryHyperdataDocuments :: [HyperdataDocument]
 202 arbitraryHyperdataDocuments =
 203   map toHyperdataDocument' ([ ("AI is big but less than crypto", "Troll System journal")
 204                             , ("Crypto is big but less than AI", "System Troll review" )
 205                             , ("Science is magic"              , "Closed Source review")
 206                             , ("Open science for all"          , "No Time"             )
 207                             , ("Closed science for me"         , "No Space"            )
 208                             ] :: [(Text, Text)])
 209   where
 210     toHyperdataDocument' (t1,t2) =
 211       HyperdataDocument Nothing Nothing Nothing Nothing Nothing Nothing (Just t1)
 212                       Nothing Nothing (Just t2) Nothing Nothing Nothing Nothing Nothing
 213                       Nothing Nothing Nothing   Nothing
 214
 215 ------------------------------------------------------------------------
 216 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
 217     deriving (Show, Generic)
 218 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 219
 220 ------------------------------------------------------------------------
 221 -- level: debug | dev  (fatal = critical)
 222 data EventLevel = CRITICAL | FATAL | ERROR | WARNING | INFO | DEBUG
 223   deriving (Show, Generic, Enum, Bounded)
 224
 225 instance FromJSON EventLevel
 226 instance ToJSON EventLevel
 227
 228 instance Arbitrary EventLevel where
 229   arbitrary = elements [minBound..maxBound]
 230
 231 instance ToSchema EventLevel where
 232   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 233
 234 ------------------------------------------------------------------------
 235
 236 data Event = Event { event_level   :: !EventLevel
 237                    , event_message :: !Text
 238                    , event_date    :: !UTCTime
 239             } deriving (Show, Generic)
 240 $(deriveJSON (unPrefix "event_") ''Event)
 241
 242 instance Arbitrary Event where
 243   arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
 244
 245 instance ToSchema Event where
 246   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 247
 248 ------------------------------------------------------------------------
 249 instance Arbitrary Text where
 250   arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
 251
 252 data Resource = Resource { resource_path    :: !(Maybe Text)
 253                          , resource_scraper :: !(Maybe Text)
 254                          , resource_query   :: !(Maybe Text)
 255                          , resource_events  :: !([Event])
 256                          , resource_status  :: !Status
 257                          , resource_date    :: !UTCTime'
 258                          } deriving (Show, Generic)
 259 $(deriveJSON (unPrefix "resource_") ''Resource)
 260
 261 instance Arbitrary Resource where
 262     arbitrary = Resource <$> arbitrary
 263                          <*> arbitrary
 264                          <*> arbitrary
 265                          <*> arbitrary
 266                          <*> arbitrary
 267                          <*> arbitrary
 268
 269 instance ToSchema Resource where
 270   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 271
 272 ------------------------------------------------------------------------
 273 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
 274                                        } deriving (Show, Generic)
 275 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 276
 277 instance Hyperdata HyperdataUser
 278 ------------------------------------------------------------------------
 279 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
 280                                        } deriving (Show, Generic)
 281 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 282
 283 instance Hyperdata HyperdataFolder
 284 ------------------------------------------------------------------------
 285 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: !(Maybe Text)
 286                                        , hyperdataCorpus_desc         :: !(Maybe Text)
 287                                        , hyperdataCorpus_query        :: !(Maybe Text)
 288                                        , hyperdataCorpus_authors      :: !(Maybe Text)
 289                                        , hyperdataCorpus_resources    :: !(Maybe [Resource])
 290                                        } deriving (Show, Generic)
 291 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 292
 293 instance Hyperdata HyperdataCorpus
 294
 295 corpusExample :: ByteString
 296 corpusExample = "" -- TODO
 297
 298 defaultCorpus :: HyperdataCorpus
 299 defaultCorpus = (HyperdataCorpus (Just "Title") (Just "Descr") (Just "Bool query") (Just "Authors") Nothing)
 300
 301 hyperdataCorpus :: HyperdataCorpus
 302 hyperdataCorpus = case decode corpusExample of
 303   Just hp -> hp
 304   Nothing -> defaultCorpus
 305
 306 instance Arbitrary HyperdataCorpus where
 307     arbitrary = pure hyperdataCorpus -- TODO
 308
 309 ------------------------------------------------------------------------
 310 data HyperdataTexts = HyperdataTexts { hyperdataTexts_desc    :: Maybe Text
 311                                        } deriving (Show, Generic)
 312 $(deriveJSON (unPrefix "hyperdataTexts_") ''HyperdataTexts)
 313
 314 instance Hyperdata HyperdataTexts
 315 ------------------------------------------------------------------------
 316 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: !(Maybe Text)
 317                                            , hyperdataAnnuaire_desc         :: !(Maybe Text)
 318                                            } deriving (Show, Generic)
 319 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 320
 321 instance Hyperdata HyperdataAnnuaire
 322
 323 hyperdataAnnuaire :: HyperdataAnnuaire
 324 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
 325
 326 instance Arbitrary HyperdataAnnuaire where
 327     arbitrary = pure hyperdataAnnuaire -- TODO
 328
 329 ------------------------------------------------------------------------
 330 newtype HyperdataAny = HyperdataAny Object
 331   deriving (Show, Generic, ToJSON, FromJSON)
 332
 333 instance Hyperdata HyperdataAny
 334
 335 instance Arbitrary HyperdataAny where
 336     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 337 ------------------------------------------------------------------------
 338
 339 data HyperdataList = HyperdataList { hyperdataList_preferences   :: !(Maybe Text)
 340                                    } deriving (Show, Generic)
 341 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 342
 343 instance Hyperdata HyperdataList
 344
 345 instance Arbitrary HyperdataList where
 346   arbitrary = elements [HyperdataList (Just "from list A")]
 347
 348                       ----
 349 data HyperdataListModel = HyperdataListModel { _hlm_params  :: !(Int, Int)
 350                                              , _hlm_path    :: !Text
 351                                              , _hlm_score   :: !(Maybe Double)
 352                                    } deriving (Show, Generic)
 353
 354 instance Hyperdata HyperdataListModel
 355 instance Arbitrary HyperdataListModel where
 356   arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
 357
 358 $(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
 359 $(makeLenses ''HyperdataListModel)
 360
 361 ------------------------------------------------------------------------
 362 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: !(Maybe Text)
 363                                    } deriving (Show, Generic)
 364 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 365
 366 instance Hyperdata HyperdataScore
 367
 368 ------------------------------------------------------------------------
 369
 370 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: !(Maybe Text)
 371                                    } deriving (Show, Generic)
 372 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 373
 374 instance Hyperdata HyperdataResource
 375
 376 ------------------------------------------------------------------------
 377 data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: !(Maybe Text)
 378                                    } deriving (Show, Generic)
 379 $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 380
 381 instance Hyperdata HyperdataDashboard
 382
 383 -- TODO add the Graph Structure here
 384 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: !(Maybe Text)
 385                                    } deriving (Show, Generic)
 386 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 387
 388 instance Hyperdata HyperdataGraph
 389
 390 ------------------------------------------------------------------------
 391
 392 -- TODO add the Graph Structure here
 393 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: !(Maybe Text)
 394                                      , hyperdataPhylo_data          :: !(Maybe Phylo)
 395                                    } deriving (Show, Generic)
 396 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 397
 398 instance Hyperdata HyperdataPhylo
 399
 400 ------------------------------------------------------------------------
 401 -- | TODO FEATURE: Notebook saved in the node
 402 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: !(Maybe Text)
 403                                    } deriving (Show, Generic)
 404 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 405
 406 instance Hyperdata HyperdataNotebook
 407
 408
 409 -- | NodePoly indicates that Node has a Polymorphism Type
 410 type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 411
 412 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 413 type NodeTypeId   = Int
 414 type NodeName     = Text
 415 type TSVector     = Text
 416
 417
 418 -- | Then a Node can be either a Folder or a Corpus or a Document
 419 type NodeUser     = Node HyperdataUser
 420 type NodeFolder   = Node HyperdataFolder
 421
 422 type NodeCorpus   = Node HyperdataCorpus
 423 type NodeTexts    = Node HyperdataTexts
 424 type NodeCorpusV3 = Node HyperdataCorpus
 425 type NodeDocument = Node HyperdataDocument
 426
 427 type NodeAnnuaire = Node HyperdataAnnuaire
 428
 429 -- | Any others nodes
 430 type NodeAny      = Node HyperdataAny
 431
 432 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 433 type NodeList     = Node HyperdataList
 434 type NodeGraph    = Node HyperdataGraph
 435 type NodePhylo    = Node HyperdataPhylo
 436 type NodeNotebook = Node HyperdataNotebook
 437 ------------------------------------------------------------------------
 438 data NodeType = NodeUser
 439               | NodeFolder
 440               | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
 441               | NodeAnnuaire   | NodeContact
 442               | NodeGraph      | NodePhylo
 443               | NodeDashboard  | NodeChart
 444               | NodeList       | NodeListModel deriving (Show, Read, Eq, Generic, Bounded, Enum)
 445
 446
 447 {-
 448               -- | Metrics
 449               -- | NodeOccurrences
 450               -- | Classification
 451 -}
 452
 453 allNodeTypes :: [NodeType]
 454 allNodeTypes = [minBound ..]
 455
 456 instance FromJSON NodeType
 457 instance ToJSON NodeType
 458
 459 instance FromHttpApiData NodeType
 460   where
 461       parseUrlPiece = Right . read . unpack
 462
 463 instance ToParamSchema NodeType
 464 instance ToSchema      NodeType
 465
 466 ------------------------------------------------------------------------
 467 data NodePoly id        typename userId
 468               parentId  name     date
 469               hyperdata  = Node { _node_id        :: id
 470                                 , _node_typename  :: typename
 471
 472                                 , _node_userId    :: userId
 473                                 , _node_parentId  :: parentId
 474
 475                                 , _node_name      :: name
 476                                 , _node_date      :: date
 477
 478                                 , _node_hyperdata :: hyperdata
 479                                 } deriving (Show, Generic)
 480 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 481 $(makeLenses ''NodePoly)
 482
 483
 484 data NodePolySearch id        typename userId
 485               parentId  name     date
 486               hyperdata search = NodeSearch { _ns_id        :: id
 487                                       , _ns_typename  :: typename
 488                                       , _ns_userId    :: userId
 489                                                                 --   , nodeUniqId    :: hashId
 490                                       , _ns_parentId  :: parentId
 491                                       , _ns_name      :: name
 492                                       , _ns_date      :: date
 493
 494                                       , _ns_hyperdata :: hyperdata
 495                                       , _ns_search    :: search
 496                                       } deriving (Show, Generic)
 497 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
 498 $(makeLenses ''NodePolySearch)
 499
 500 type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
 501 ------------------------------------------------------------------------
 502
 503
 504 instance (Arbitrary hyperdata
 505          ,Arbitrary nodeId
 506          ,Arbitrary nodeTypeId
 507          ,Arbitrary userId
 508          ,Arbitrary nodeParentId
 509          ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
 510                                   NodeName UTCTime hyperdata) where
 511     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
 512     arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
 513                      <*> arbitrary <*> arbitrary <*> arbitrary
 514                      <*> arbitrary
 515
 516 instance (Arbitrary hyperdata
 517          ,Arbitrary nodeId
 518          ,Arbitrary nodeTypeId
 519          ,Arbitrary userId
 520          ,Arbitrary nodeParentId
 521          ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
 522                                   NodeName UTCTime hyperdata (Maybe TSVector)) where
 523     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
 524     arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
 525                      <*> arbitrary <*> arbitrary <*> arbitrary
 526                      <*> arbitrary <*> arbitrary
 527
 528
 529 ------------------------------------------------------------------------
 530 hyperdataDocument :: HyperdataDocument
 531 hyperdataDocument = case decode docExample of
 532                       Just hp -> hp
 533                       Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
 534                                                    Nothing Nothing Nothing Nothing
 535                                                    Nothing Nothing Nothing Nothing
 536                                                    Nothing Nothing Nothing Nothing
 537                                                    Nothing Nothing Nothing
 538 docExample :: ByteString
 539 docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
 540
 541 instance ToSchema HyperdataCorpus where
 542   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 543     & mapped.schema.description ?~ "a corpus"
 544     & mapped.schema.example ?~ toJSON hyperdataCorpus
 545
 546 instance ToSchema HyperdataAnnuaire where
 547   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 548     & mapped.schema.description ?~ "an annuaire"
 549     & mapped.schema.example ?~ toJSON hyperdataAnnuaire
 550
 551 instance ToSchema HyperdataDocument where
 552   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 553     & mapped.schema.description ?~ "a document"
 554     & mapped.schema.example ?~ toJSON hyperdataDocument
 555
 556 instance ToSchema HyperdataAny where
 557   declareNamedSchema proxy =
 558     pure $ genericNameSchema defaultSchemaOptions proxy mempty
 559              & schema.description ?~ "a node"
 560              & schema.example ?~ emptyObject -- TODO
 561
 562
 563 instance ToSchema hyperdata =>
 564          ToSchema (NodePoly NodeId NodeTypeId
 565                             (Maybe UserId)
 566                             ParentId NodeName
 567                             UTCTime hyperdata
 568                   )
 569
 570 instance ToSchema hyperdata =>
 571          ToSchema (NodePoly NodeId NodeTypeId
 572                             UserId
 573                             (Maybe ParentId) NodeName
 574                             UTCTime hyperdata
 575                   )
 576
 577
 578 instance ToSchema hyperdata =>
 579          ToSchema (NodePolySearch NodeId NodeTypeId
 580                             (Maybe UserId)
 581                             ParentId NodeName
 582                             UTCTime hyperdata (Maybe TSVector)
 583                   )
 584
 585 instance ToSchema hyperdata =>
 586          ToSchema (NodePolySearch NodeId NodeTypeId
 587                             UserId
 588                             (Maybe ParentId) NodeName
 589                             UTCTime hyperdata (Maybe TSVector)
 590                   )
 591
 592
 593 instance ToSchema Status
 594
 595