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