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