src/Gargantext/Database/Schema/NodesNgramsRepo.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodesNgramsRepo
   3 Description : NodeNgram for Ngram indexation or Lists
   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
  13 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  14
  15 {-# LANGUAGE Arrows                     #-}
  16 {-# LANGUAGE FlexibleContexts           #-}
  17 {-# LANGUAGE FlexibleInstances          #-}
  18 {-# LANGUAGE FunctionalDependencies     #-}
  19 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  20 {-# LANGUAGE MultiParamTypeClasses      #-}
  21 {-# LANGUAGE NoImplicitPrelude          #-}
  22 {-# LANGUAGE OverloadedStrings          #-}
  23 {-# LANGUAGE QuasiQuotes                #-}
  24 {-# LANGUAGE RankNTypes                 #-}
  25 {-# LANGUAGE TemplateHaskell            #-}
  26
  27
  28 module Gargantext.Database.Schema.NodesNgramsRepo
  29   where
  30
  31 import Control.Arrow (returnA)
  32 import Control.Lens.TH (makeLenses)
  33 import Data.Map.Strict.Patch (PatchMap)
  34 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  35 import Gargantext.API.Ngrams (NgramsStatePatch, NgramsTablePatch)
  36 import Gargantext.Database.Schema.Ngrams (NgramsType)
  37 import Gargantext.Database.Admin.Types.Node (NodeId)
  38 import Gargantext.Database.Admin.Utils (mkCmd, Cmd, runOpaQuery)
  39 import Gargantext.Prelude
  40 import Opaleye
  41
  42
  43 data RepoDbPoly version patches
  44    = RepoDbNgrams { _rdp_version :: !version
  45                   , _rdp_patches :: !patches
  46                   } deriving (Show)
  47
  48 type RepoDbWrite
  49   = RepoDbPoly (Column PGInt4)
  50              (Column PGJsonb)
  51 type RepoDbRead
  52   = RepoDbPoly (Column PGInt4)
  53              (Column PGJsonb)
  54
  55 type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
  56 $(makeAdaptorAndInstance "pRepoDbNgrams" ''RepoDbPoly)
  57 makeLenses ''RepoDbPoly
  58
  59 instance QueryRunnerColumnDefault PGJsonb
  60                           (PatchMap NgramsType
  61                           (PatchMap NodeId NgramsTablePatch))
  62   where
  63     queryRunnerColumnDefault = fieldQueryRunnerColumn
  64
  65 -- type Re
  66 repoTable :: Table RepoDbWrite RepoDbRead
  67 repoTable = Table "nodes_ngrams_repo"
  68     (pRepoDbNgrams RepoDbNgrams
  69                    { _rdp_version = required "version"
  70                    , _rdp_patches = required "patches"
  71                    }
  72     )
  73
  74
  75 selectRepo :: Cmd err [RepoDbNgrams]
  76 selectRepo =  runOpaQuery selectPatches
  77
  78 selectPatches :: Query RepoDbRead
  79 selectPatches = proc () -> do
  80   repos <- queryTable repoTable -< ()
  81   returnA -< repos
  82
  83
  84 insertRepos :: [NgramsStatePatch] -> Cmd err Int64
  85 insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite ns) rCount Nothing
  86   where
  87     toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
  88     toWrite = undefined
  89     --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (pgInt4 v) (pgJSONB ps)) ns
  90