src/Gargantext/Database/Schema/Context.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.Node
   3 Description : Main requests of Node to the 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 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  12
  13 {-# LANGUAGE Arrows                 #-}
  14 {-# LANGUAGE ConstraintKinds        #-}
  15 {-# LANGUAGE FunctionalDependencies #-}
  16 {-# LANGUAGE TemplateHaskell        #-}
  17 {-# LANGUAGE TypeFamilies           #-}
  18
  19 module Gargantext.Database.Schema.Context where
  20
  21 import Control.Lens hiding (elements, (&), Context)
  22 import Gargantext.Database.Schema.Prelude
  23 import Prelude hiding (null, id, map, sum)
  24
  25
  26 ------------------------------------------------------------------------
  27 -- Main polymorphic Node definition
  28 data ContextPoly id
  29                  hash_id
  30                  typename
  31                  user_id
  32                  parent_id
  33                  name
  34                  date
  35                  hyperdata  =
  36      Context { _context_id        :: !id
  37              , _context_hash_id   :: !hash_id
  38              , _context_typename  :: !typename
  39
  40              , _context_user_id    :: !user_id
  41              , _context_parent_id  :: !parent_id
  42
  43              , _context_name      :: !name
  44              , _context_date      :: !date
  45
  46              , _context_hyperdata :: !hyperdata
  47              } deriving (Show, Generic)
  48
  49 ------------------------------------------------------------------------
  50 -- Automatic instances derivation
  51 $(deriveJSON (unPrefix "_context_") ''ContextPoly)
  52 $(makeLenses ''ContextPoly)
  53
  54 $(makeAdaptorAndInstance "pContext" ''ContextPoly)
  55 $(makeLensesWith abbreviatedFields  ''ContextPoly)
  56
  57 contextTable :: Table ContextWrite ContextRead
  58 contextTable = Table "contexts" (pContext Context { _context_id         = optionalTableField "id"
  59                                                   , _context_hash_id    = optionalTableField "hash_id"
  60                                                   , _context_typename   = requiredTableField "typename"
  61                                                   , _context_user_id    = requiredTableField "user_id"
  62
  63                                                   , _context_parent_id  = optionalTableField "parent_id"
  64                                                   , _context_name       = requiredTableField "name"
  65                                                   , _context_date       = optionalTableField "date"
  66
  67                                                   , _context_hyperdata  = requiredTableField "hyperdata"
  68                                                   -- ignoring ts_vector field here
  69                                                   }
  70                                         )
  71
  72 queryContextTable :: Query ContextRead
  73 queryContextTable = selectTable contextTable
  74 ------------------------------------------------------------------------
  75 type ContextWrite = ContextPoly (Maybe (Field SqlInt4)      )
  76                           (Maybe (Field SqlText)      )
  77                                  (Field SqlInt4)
  78                                  (Field SqlInt4)
  79                           (Maybe (Field SqlInt4)      )
  80                                  (Field SqlText)
  81                           (Maybe (Field SqlTimestamptz))
  82                                  (Field SqlJsonb)
  83
  84 type ContextRead = ContextPoly (Field SqlInt4        )
  85                          (Field SqlText        )
  86                          (Field SqlInt4        )
  87                          (Field SqlInt4        )
  88                          (Field SqlInt4        )
  89                          (Field SqlText        )
  90                          (Field SqlTimestamptz )
  91                          (Field SqlJsonb       )
  92 ------------------------------------------------------------------------
  93 -- | Context(Read|Write)Search is slower than Context(Write|Read) use it
  94 -- for full text search only
  95
  96 type ContextSearchWrite =
  97   ContextPolySearch
  98     (Maybe  (Field  SqlInt4)      )
  99     (Field  SqlInt4               )
 100     (Field  SqlInt4               )
 101     (FieldNullable SqlInt4)
 102     (Field SqlText                )
 103     (Maybe  (Field SqlTimestamptz))
 104     (Field  SqlJsonb              )
 105     (Maybe  (Field SqlTSVector)   )
 106
 107 type ContextSearchRead =
 108   ContextPolySearch
 109     (Field  SqlInt4           )
 110     (Field  SqlInt4           )
 111     (Field  SqlInt4           )
 112     (FieldNullable SqlInt4 )
 113     (Field  SqlText           )
 114     (Field  SqlTimestamptz    )
 115     (Field  SqlJsonb          )
 116     (Field  SqlTSVector       )
 117
 118 data ContextPolySearch id
 119                     typename
 120                     user_id
 121                     parent_id
 122                     name
 123                     date
 124                     hyperdata
 125                     search =
 126      ContextSearch { _cs_id           :: id
 127                    , _cs_typename     :: typename
 128                    , _cs_user_id      :: user_id
 129               --   , ContextUniqId       :: shaId
 130                    , _cs_parent_id    :: parent_id
 131                    , _cs_name         :: name
 132                    , _cs_date         :: date
 133
 134                    , _cs_hyperdata    :: hyperdata
 135                    , _cs_search       :: search
 136                    } deriving (Show, Generic)
 137
 138 $(makeAdaptorAndInstance "pContextSearch" ''ContextPolySearch)
 139 $(makeLensesWith abbreviatedFields        ''ContextPolySearch)
 140 $(deriveJSON (unPrefix "_cs_")            ''ContextPolySearch)
 141 $(makeLenses                              ''ContextPolySearch)
 142
 143 contextTableSearch :: Table ContextSearchWrite ContextSearchRead
 144 contextTableSearch = Table "contexts" ( pContextSearch
 145                                    ContextSearch { _cs_id           = optionalTableField "id"
 146                                                  , _cs_typename     = requiredTableField "typename"
 147                                                  , _cs_user_id      = requiredTableField "user_id"
 148
 149                                                  , _cs_parent_id    = requiredTableField "parent_id"
 150                                                  , _cs_name         = requiredTableField "name"
 151                                                  , _cs_date         = optionalTableField "date"
 152
 153                                                  , _cs_hyperdata    = requiredTableField "hyperdata"
 154                                                  , _cs_search       = optionalTableField "search"
 155                                                  }
 156                                      )
 157 ------------------------------------------------------------------------