src/Data/Gargantext/Database/Node.hs

   1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
   2 {-# LANGUAGE TemplateHaskell #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE MultiParamTypeClasses #-}
   6 {-# LANGUAGE FunctionalDependencies #-}
   7 {-# LANGUAGE Arrows #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9
  10 module Data.Gargantext.Database.Node where
  11
  12 import Database.PostgreSQL.Simple.FromField ( Conversion
  13                                             , ResultError(ConversionFailed)
  14                                             , FromField
  15                                             , fromField
  16                                             , returnError
  17                                             )
  18 import Database.PostgreSQL.Simple.Internal  (Field)
  19 import Control.Arrow (returnA)
  20 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  21 import Data.Aeson
  22 import Data.Gargantext.Types
  23 import Data.Gargantext.Prelude
  24 import Data.Maybe (Maybe, fromMaybe)
  25 import Data.Text (Text)
  26 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  27 import Data.Typeable (Typeable)
  28 import qualified Data.ByteString.Internal as DBI
  29 import Database.PostgreSQL.Simple (Connection)
  30 import Opaleye
  31
  32 -- | Types for Node Database Management
  33 data PGTSVector
  34
  35 type NodeWrite = NodePoly  (Maybe (Column PGInt4))  (Column PGInt4)
  36                                   (Column PGInt4)   (Column (Nullable PGInt4))
  37                                   (Column (PGText)) (Maybe (Column PGTimestamptz))
  38                                   (Column PGJsonb) -- (Maybe (Column PGTSVector))
  39
  40 type NodeRead = NodePoly  (Column PGInt4)   (Column PGInt4)
  41                           (Column PGInt4)   (Column (Nullable PGInt4))
  42                           (Column (PGText)) (Column PGTimestamptz)
  43                           (Column PGJsonb) -- (Column PGTSVector)
  44
  45 instance FromField HyperdataCorpus where
  46     fromField = fromField'
  47
  48 instance FromField HyperdataDocument where
  49     fromField = fromField'
  50
  51 instance FromField HyperdataProject where
  52     fromField = fromField'
  53
  54 instance FromField HyperdataUser where
  55     fromField = fromField'
  56
  57
  58 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
  59 fromField' field mb = do
  60     v <- fromField field mb
  61     valueToHyperdata v
  62       where
  63           valueToHyperdata v = case fromJSON v of
  64              Success a  -> pure a
  65              Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
  66
  67
  68 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
  69   queryRunnerColumnDefault = fieldQueryRunnerColumn
  70
  71 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
  72   queryRunnerColumnDefault = fieldQueryRunnerColumn
  73
  74 instance QueryRunnerColumnDefault PGJsonb HyperdataProject  where
  75   queryRunnerColumnDefault = fieldQueryRunnerColumn
  76
  77 instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
  78   queryRunnerColumnDefault = fieldQueryRunnerColumn
  79
  80 instance QueryRunnerColumnDefault (Nullable PGInt4) Int     where
  81   queryRunnerColumnDefault = fieldQueryRunnerColumn
  82
  83 instance QueryRunnerColumnDefault (Nullable PGText) Text    where
  84   queryRunnerColumnDefault = fieldQueryRunnerColumn
  85
  86 instance QueryRunnerColumnDefault PGInt4 Integer            where
  87     queryRunnerColumnDefault = fieldQueryRunnerColumn
  88
  89
  90
  91 $(makeAdaptorAndInstance "pNode" ''NodePoly)
  92 $(makeLensesWith abbreviatedFields   ''NodePoly)
  93
  94
  95 nodeTable :: Table NodeWrite NodeRead
  96 nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
  97                                         , node_typename        = required "typename"
  98                                         , node_userId          = required "user_id"
  99                                         , node_parentId        = required "parent_id"
 100                                         , node_name            = required "name"
 101                                         , node_date            = optional "date"
 102                                         , node_hyperdata       = required "hyperdata"
 103                      --                   , node_titleAbstract   = optional "title_abstract"
 104                                         }
 105                             )
 106
 107
 108 selectNodes :: Column PGInt4 -> Query NodeRead
 109 selectNodes id = proc () -> do
 110     row <- queryNodeTable -< ()
 111     restrict -< node_id row .== id
 112     returnA -< row
 113
 114 runGetNodes :: Connection -> Query NodeRead -> IO [Document]
 115 runGetNodes = runQuery
 116
 117
 118 queryNodeTable :: Query NodeRead
 119 queryNodeTable = queryTable nodeTable
 120
 121
 122 selectNodeWithParentID :: Column (Nullable PGInt4) -> Query NodeRead
 123 selectNodeWithParentID node_id = proc () -> do
 124     row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
 125     -- restrict -< maybe (isNull p_id) (p_id .==) node_id
 126     restrict -< p_id .== node_id
 127     returnA -< row
 128
 129 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 130 selectNodesWithType type_id = proc () -> do
 131     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 132     restrict -< tn .== type_id
 133     returnA -< row
 134
 135 getNode :: Connection -> Column PGInt4 -> IO (Node Value)
 136 getNode conn id = do
 137     fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes id)
 138
 139 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
 140 getNodesWithType conn type_id = do
 141     runQuery conn $ selectNodesWithType type_id
 142
 143 -- NP check type
 144 getNodesWithParentId :: Connection -> Column (Nullable PGInt4) -> IO [Node Value]
 145 getNodesWithParentId conn node_id = do
 146     runQuery conn $ selectNodeWithParentID node_id
 147
 148 -- NP check type
 149 getCorpusDocument :: Connection -> Column PGInt4 -> IO [Document]
 150 getCorpusDocument conn node_id = runQuery conn (selectNodeWithParentID $ toNullable node_id)
 151
 152 -- NP check type
 153 getProjectCorpora :: Connection -> Column (Nullable PGInt4) -> IO [Corpus]
 154 getProjectCorpora conn node_id = do
 155     runQuery conn $ selectNodeWithParentID node_id