Merge remote-tracking branch 'origin/dev-hackathon-fixes' into dev
[gargantext.git] / src / Gargantext / Database / Schema / NodesNgramsRepo.hs
index 77721a0da173253e52c48516b6a3b587c3ebc737..cd78997156e745d29d5472609f202de45445a181 100644 (file)
@@ -13,76 +13,51 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 
 {-# LANGUAGE Arrows                     #-}
-{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE TemplateHaskell            #-}
 
 
-module Gargantext.Database.Schema.NodesNgramsRepo where
+module Gargantext.Database.Schema.NodesNgramsRepo
+  where
 
-import Control.Arrow (returnA)
-import Control.Lens.TH (makeLenses)
+{-
 import Data.Map.Strict.Patch (PatchMap)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Gargantext.API.Ngrams (NgramsStatePatch, NgramsTablePatch)
+
+import Gargantext.Database.Schema.Prelude
+import Gargantext.API.Ngrams.Types (NgramsTablePatch)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
-import Gargantext.Database.Types.Node (NodeId)
-import Gargantext.Database.Utils (mkCmd, Cmd, runOpaQuery)
+import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Prelude
-import Opaleye
 
 
 data RepoDbPoly version patches
-   = RepoDbNgrams { _rdp_version :: version
-              , _rdp_patches :: patches
-              } deriving (Show)
+   = RepoDbNgrams { _rdp_version :: !version
+                  , _rdp_patches :: !patches
+                  } deriving (Show)
 
 type RepoDbWrite
-  = RepoDbPoly (Column PGInt4)
-             (Column PGJsonb)
+  = RepoDbPoly (Column SqlInt4)
+             (Column SqlJsonb)
 type RepoDbRead
-  = RepoDbPoly (Column PGInt4)
-             (Column PGJsonb)
+  = RepoDbPoly (Column SqlInt4)
+             (Column SqlJsonb)
 
 type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
 $(makeAdaptorAndInstance "pRepoDbNgrams" ''RepoDbPoly)
 makeLenses ''RepoDbPoly
 
-instance QueryRunnerColumnDefault PGJsonb
+instance DefaultFromField SqlJsonb
                           (PatchMap NgramsType
                           (PatchMap NodeId NgramsTablePatch))
   where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
+    defaultFromField = fromPGSFromField
 
--- type Re
 repoTable :: Table RepoDbWrite RepoDbRead
 repoTable = Table "nodes_ngrams_repo"
     (pRepoDbNgrams RepoDbNgrams
-                   { _rdp_version = required "version"
-                   , _rdp_patches = required "patches"
+                   { _rdp_version = requiredTableField "version"
+                   , _rdp_patches = requiredTableField "patches"
                    }
     )
-
-
-selectRepo :: Cmd err [RepoDbNgrams]
-selectRepo =  runOpaQuery selectPatches
-
-selectPatches :: Query RepoDbRead
-selectPatches = proc () -> do
-  repos <- queryTable repoTable -< ()
-  returnA -< repos
-
-
-insertRepos :: [NgramsStatePatch] -> Cmd err Int64
-insertRepos ns = mkCmd $ \conn -> runInsertMany conn repoTable (toWrite ns)
-  where
-    toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
-    toWrite = undefined
-    --ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (pgInt4 v) (pgJSONB ps)) ns
-
+-}