src/Gargantext/Database/Schema/Node.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-name-shadowing #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE DeriveGeneric          #-}
  16 {-# LANGUAGE ConstraintKinds        #-}
  17 {-# LANGUAGE FlexibleContexts       #-}
  18 {-# LANGUAGE FlexibleInstances      #-}
  19 {-# LANGUAGE FunctionalDependencies #-}
  20 {-# LANGUAGE OverloadedStrings      #-}
  21 {-# LANGUAGE MultiParamTypeClasses  #-}
  22 {-# LANGUAGE NoImplicitPrelude      #-}
  23 {-# LANGUAGE RankNTypes             #-}
  24 {-# LANGUAGE TemplateHaskell        #-}
  25 {-# LANGUAGE TypeFamilies           #-}
  26
  27 module Gargantext.Database.Schema.Node where
  28
  29 import Control.Lens hiding (elements, (&))
  30 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  31 import Data.Aeson.TH (deriveJSON)
  32 import Data.Maybe (Maybe(..))
  33 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  34 import Data.Swagger hiding (required)
  35 import Data.Text (Text)
  36 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  37 import GHC.Generics (Generic)
  38 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  39 import Gargantext.Database.Admin.Utils
  40 import Opaleye hiding (FromField)
  41 import Opaleye.Internal.QueryArr (Query)
  42 import Prelude hiding (null, id, map, sum)
  43 import Test.QuickCheck.Arbitrary
  44
  45
  46 ------------------------------------------------------------------------
  47 data NodePoly id        typename userId
  48               parentId  name     date
  49               hyperdata  = Node { _node_id        :: id
  50                                 , _node_typename  :: typename
  51
  52                                 , _node_userId    :: userId
  53                                 , _node_parentId  :: parentId
  54
  55                                 , _node_name      :: name
  56                                 , _node_date      :: date
  57
  58                                 , _node_hyperdata :: hyperdata
  59                                 } deriving (Show, Generic)
  60
  61 $(deriveJSON (unPrefix "_node_") ''NodePoly)
  62 $(makeLenses ''NodePoly)
  63
  64 $(makeAdaptorAndInstance "pNode"   ''NodePoly)
  65 $(makeLensesWith abbreviatedFields ''NodePoly)
  66
  67 ------------------------------------------------------------------------
  68 nodeTable :: Table NodeWrite NodeRead
  69 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
  70                                       , _node_typename   = required "typename"
  71                                       , _node_userId     = required "user_id"
  72
  73                                       , _node_parentId   = optional "parent_id"
  74                                       , _node_name       = required "name"
  75                                       , _node_date       = optional "date"
  76
  77                                       , _node_hyperdata  = required "hyperdata"
  78                                       -- ignoring ts_vector field here
  79                                       }
  80                             )
  81
  82 queryNodeTable :: Query NodeRead
  83 queryNodeTable = queryTable nodeTable
  84 ------------------------------------------------------------------------
  85 type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
  86                                  (Column PGInt4)
  87                                  (Column PGInt4)
  88                           (Maybe (Column PGInt4)      )
  89                                  (Column PGText)
  90                           (Maybe (Column PGTimestamptz))
  91                                  (Column PGJsonb)
  92
  93 type NodeRead = NodePoly (Column PGInt4        )
  94                          (Column PGInt4        )
  95                          (Column PGInt4        )
  96                          (Column PGInt4        )
  97                          (Column PGText        )
  98                          (Column PGTimestamptz )
  99                          (Column PGJsonb       )
 100
 101 type NodeReadNull = NodePoly (Column (Nullable PGInt4))
 102                              (Column (Nullable PGInt4))
 103                              (Column (Nullable PGInt4))
 104                              (Column (Nullable PGInt4))
 105                              (Column (Nullable PGText))
 106                              (Column (Nullable PGTimestamptz))
 107                              (Column (Nullable PGJsonb))
 108
 109 ------------------------------------------------------------------------
 110 -- | Node(Read|Write)Search is slower than Node(Write|Read) use it
 111 -- for full text search only
 112
 113 type NodeSearchWrite =
 114   NodePolySearch
 115     (Maybe  (Column  PGInt4)      )
 116     (Column  PGInt4               )
 117     (Column  PGInt4               )
 118     (Column (Nullable PGInt4)     )
 119     (Column PGText                )
 120     (Maybe  (Column PGTimestamptz))
 121     (Column  PGJsonb              )
 122     (Maybe  (Column PGTSVector)   )
 123
 124 type NodeSearchRead =
 125   NodePolySearch
 126     (Column  PGInt4           )
 127     (Column  PGInt4           )
 128     (Column  PGInt4           )
 129     (Column (Nullable PGInt4 ))
 130     (Column  PGText           )
 131     (Column  PGTimestamptz    )
 132     (Column  PGJsonb          )
 133     (Column  PGTSVector       )
 134
 135 type NodeSearchReadNull =
 136   NodePolySearch
 137     (Column (Nullable PGInt4)       )
 138     (Column (Nullable PGInt4)       )
 139     (Column (Nullable PGInt4)       )
 140     (Column (Nullable PGInt4)       )
 141     (Column (Nullable PGText)       )
 142     (Column (Nullable PGTimestamptz))
 143     (Column (Nullable PGJsonb)      )
 144     (Column (Nullable PGTSVector)   )
 145
 146
 147 data NodePolySearch id        typename userId
 148               parentId  name     date
 149               hyperdata search = NodeSearch { _ns_id        :: id
 150                                       , _ns_typename  :: typename
 151                                       , _ns_userId    :: userId
 152                                                                 --   , nodeUniqId    :: shaId
 153                                       , _ns_parentId  :: parentId
 154                                       , _ns_name      :: name
 155                                       , _ns_date      :: date
 156
 157                                       , _ns_hyperdata :: hyperdata
 158                                       , _ns_search    :: search
 159                                       } deriving (Show, Generic)
 160
 161 $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
 162 $(makeLensesWith abbreviatedFields ''NodePolySearch)
 163 $(deriveJSON (unPrefix "_ns_")     ''NodePolySearch)
 164 $(makeLenses ''NodePolySearch)
 165
 166 nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
 167 nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id         = optional "id"
 168                                       , _ns_typename   = required "typename"
 169                                       , _ns_userId     = required "user_id"
 170
 171                                       , _ns_parentId   = required "parent_id"
 172                                       , _ns_name       = required "name"
 173                                       , _ns_date       = optional "date"
 174
 175                                       , _ns_hyperdata  = required "hyperdata"
 176                                       , _ns_search     = optional "search"
 177                                       }
 178                             )
 179 ------------------------------------------------------------------------