From 010decf8182eb9ce96d55a5d0c017ffcebd31d2b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Alexandre=20Delano=C3=AB?= <devel+git@delanoe.org>
Date: Fri, 15 Jun 2018 17:14:27 +0200
Subject: [PATCH] [BASQHL] first basic function and todo list.
---
src/Gargantext/Core/Types/Node.hs | 3 +
src/Gargantext/Database.hs | 110 ++++++++++++++++++++++++------
src/Gargantext/Database/Node.hs | 84 ++++++++++++++++++++---
src/Gargantext/Prelude.hs | 6 +-
4 files changed, 168 insertions(+), 35 deletions(-)
diff --git a/src/Gargantext/Core/Types/Node.hs b/src/Gargantext/Core/Types/Node.hs
index bee9ce8f..45650a60 100644
--- a/src/Gargantext/Core/Types/Node.hs
+++ b/src/Gargantext/Core/Types/Node.hs
@@ -265,6 +265,9 @@ data NodePoly id typename userId parentId name date hyperdata = Node { node_id
} deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''NodePoly)
+
+
+
instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime Value) where
arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (toJSON ("{}"::Text))]
diff --git a/src/Gargantext/Database.hs b/src/Gargantext/Database.hs
index 76f426c0..ab09ef10 100644
--- a/src/Gargantext/Database.hs
+++ b/src/Gargantext/Database.hs
@@ -12,7 +12,7 @@ Portability : POSIX
* Which language to chose when working with a database ? To make it
simple, instead of all common Object Relational Mapping (ORM) [1]
strategy used nowadays inspired more by object logic than functional
-logic, the semantics of BASHQL focus on the function first.
+logic, the semantics of BASHQL with focus on the function first.
* BASHQL focus on the function, i.e. use bash language function name,
and make it with SQL behind the scene. Then BASHQL is inspired more
@@ -57,40 +57,106 @@ AMS, and by SIAM.
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database ( module Gargantext.Database.Utils
- , ls')
+ , get
+ , ls , ls'
+ , home, home'
+ , post, post'
+ , del , del'
+ )
where
import Gargantext.Core.Types
+import Gargantext.Core.Types.Node
import Gargantext.Database.Utils (connectGargandb)
import Gargantext.Database.Node
import Gargantext.Prelude
import Database.PostgreSQL.Simple (Connection)
-
+import Data.Text (Text)
import Opaleye hiding (FromField)
import Data.Aeson
--- type PWD = Node NodeId
--- type Path = [PWD]
-
--- pwd :: [Node NodeId] ->
+import Data.ByteString (ByteString)
+import Data.List (last)
+type UserId = Int
+--type NodeId = Int
+
+-- List of NodeId
+-- type PWD a = PWD UserId [a]
+type PWD = [NodeId]
+
+-- | TODO get Children or Node
+get :: Connection -> PWD -> IO [Node Value]
+get _ [] = pure []
+get conn pwd = runQuery conn $ selectNodesWithParentID (last pwd)
+
+-- | Home, need to filter with UserId
+home :: Connection -> IO PWD
+home c = map node_id <$> getNodesWithParentId c 0 Nothing
+
+-- | ls == get Children
+ls :: Connection -> PWD -> IO [Node Value]
+ls = get
+
+-- | TODO
+-- post User
+-- post Dir
+-- post Corpus Parent_id (Empty|MyData)
+-- post CorpusWith
+-- post List
+post :: Connection -> PWD -> [NodeWrite'] -> IO Int64
+post _ [] _ = pure 0
+post _ _ [] = pure 0
+post c pth ns = mkNode c (last pth) ns
+
+rm :: Connection -> PWD -> [NodeId] -> IO Int
+rm = del
+
+del :: Connection -> PWD -> [NodeId] -> IO Int
+del _ [] _ = pure 0
+del _ _ [] = pure 0
+del c pth ns = deleteNodes c ns
+
+put :: Connection -> PWD -> [a] -> IO Int64
+put = undefined
+
+-- | TODO
+-- cd (Home UserId) | (Node NodeId)
+-- cd Path
+-- jump NodeId
+-- touch Dir
+--------------------------------------------------------------
+-- Tests
+--------------------------------------------------------------
-ls :: Connection -> Int -> IO [Node Value]
-ls conn n = runQuery conn $ selectNodesWithParentID n
+home' :: IO PWD
+home' = do
+ c <- connectGargandb "gargantext.ini"
+ home c
ls' :: IO [Node Value]
-ls' = connectGargandb "gargantext.ini" >>= \c -> ls c 347474
+ls' = do
+ c <- connectGargandb "gargantext.ini"
+ h <- home c
+ ls c h
+
+post' :: IO Int64
+post' = do
+ c <- connectGargandb "gargantext.ini"
+ h <- home c
+ let userId = 1
+ -- TODO semantic to achieve
+ -- post c h [ Corpus "name" "{}" Nothing
+ -- , Project "name" "{}" (Just [Corpus "test 2" "" Nothing])
+ -- ]
+ post c h [ node userId (last h) Corpus "name" "{}"
+ , node userId (last h) Project "name" "{}"
+ ]
+
+del' :: [NodeId] -> IO Int
+del' ns = do
+ c <- connectGargandb "gargantext.ini"
+ h <- home c
+ del c h ns
--- ls' Maybe PWD
--- cd (Home UserId) | (Node NodeId)
-
--- cd Path
--- jump PWD
-
--- mk User
--- mk Dir
--- mk Corpus Parent_id (Empty|MyData)
--- mk CorpusWith
--- mk List
--- touch Dir
diff --git a/src/Gargantext/Database/Node.hs b/src/Gargantext/Database/Node.hs
index b578ab36..d28e378a 100644
--- a/src/Gargantext/Database/Node.hs
+++ b/src/Gargantext/Database/Node.hs
@@ -21,6 +21,10 @@ Portability : POSIX
module Gargantext.Database.Node where
+import Data.ByteString (ByteString)
+import GHC.Int (Int64)
+import Data.Maybe
+import Data.Time (UTCTime)
import Database.PostgreSQL.Simple.FromField ( Conversion
, ResultError(ConversionFailed)
, FromField
@@ -28,6 +32,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
, returnError
)
import Prelude hiding (null, id, map, sum)
+import Data.Time.Segment (jour, timesAfter, Granularity(D))
import Gargantext.Core.Types
import Gargantext.Core.Types.Node (NodeType)
@@ -46,7 +51,8 @@ import Data.Typeable (Typeable)
import qualified Data.ByteString.Internal as DBI
import Database.PostgreSQL.Simple (Connection)
import Opaleye hiding (FromField)
-
+import Opaleye.Internal.QueryArr (Query(..))
+import qualified Data.Profunctor.Product as PP
-- | Types for Node Database Management
data PGTSVector
@@ -89,7 +95,7 @@ fromField' field mb = do
$(makeAdaptorAndInstance "pNode" ''NodePoly)
-$(makeLensesWith abbreviatedFields ''NodePoly)
+$(makeLensesWith abbreviatedFields ''NodePoly)
nodeTable :: Table NodeWrite NodeRead
@@ -105,12 +111,40 @@ nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
)
+nodeTable' :: Table (Maybe (Column PGInt4)
+ , Column PGInt4
+ , Column PGInt4
+ , Column PGInt4
+ , Column PGText
+ ,Maybe (Column PGTimestamptz)
+ , Column PGJsonb
+ )
+ ((Column PGInt4)
+ , Column PGInt4
+ , Column PGInt4
+ , Column PGInt4
+ , Column PGText
+ ,(Column PGTimestamptz)
+ , Column PGJsonb
+ )
+
+nodeTable' = Table "nodes" (PP.p7 ( optional "id"
+ , required "typename"
+ , required "user_id"
+ , required "parent_id"
+ , required "name"
+ , optional "date"
+ , required "hyperdata"
+ )
+ )
+
+
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
-selectNodes :: Column PGInt4 -> Query NodeRead
-selectNodes id = proc () -> do
+selectNode :: Column PGInt4 -> Query NodeRead
+selectNode id = proc () -> do
row <- queryNodeTable -< ()
restrict -< node_id row .== id
returnA -< row
@@ -142,13 +176,11 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
deleteNode :: Connection -> Int -> IO Int
-deleteNode conn n = fromIntegral
- <$> runDelete conn nodeTable
+deleteNode conn n = fromIntegral <$> runDelete conn nodeTable
(\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
deleteNodes :: Connection -> [Int] -> IO Int
-deleteNodes conn ns = fromIntegral
- <$> runDelete conn nodeTable
+deleteNodes conn ns = fromIntegral <$> runDelete conn nodeTable
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
@@ -164,6 +196,10 @@ getNodesWithParentId :: Connection -> Int
-> Maybe Text -> IO [Node HyperdataDocument]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
+getNodesWithParentId' :: Connection -> Int
+ -> Maybe Text -> IO [Node Value]
+getNodesWithParentId' conn n _ = runQuery conn $ selectNodesWithParentID n
+
selectNodesWithParentID :: Int -> Query NodeRead
selectNodesWithParentID n = proc () -> do
@@ -182,12 +218,40 @@ selectNodesWithType type_id = proc () -> do
restrict -< tn .== type_id
returnA -< row
+getNode' :: Connection -> Int -> IO (Node Value)
+getNode' c id = do
+ fromMaybe (error "TODO: 404") . headMay <$> runQuery c (limit 1 $ selectNode (pgInt4 id))
+
+
getNode :: Connection -> Int -> IO (Node HyperdataDocument)
getNode conn id = do
- fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
+ fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
getNodesWithType conn type_id = do
runQuery conn $ selectNodesWithType type_id
-
+type UserId = NodeId
+type NodeWrite' = NodePoly (Maybe Int) Int Int (ParentId) Text (Maybe UTCTime) ByteString
+type TypeId = Int
+
+--node :: UserId -> ParentId -> NodeType -> Text -> Value -> NodeWrite'
+node :: UserId -> ParentId -> NodeType -> Text -> ByteString -> NodeWrite'
+node userId parentId nodeType name nodeData = Node Nothing typeId userId parentId name Nothing byteData
+ where
+ typeId = nodeTypeId nodeType
+ byteData = nodeData
+ --byteData = encode nodeData
+
+node2write pid (Node id tn ud _ nm dt hp) = ((pgInt4 <$> id)
+ ,(pgInt4 tn)
+ ,(pgInt4 ud)
+ ,(pgInt4 pid)
+ ,(pgStrictText nm)
+ ,(pgUTCTime <$> dt)
+ ,(pgStrictJSONB hp)
+ )
+
+
+mkNode :: Connection -> ParentId -> [NodeWrite'] -> IO Int64
+mkNode conn pid ns = runInsertMany conn nodeTable' $ map (node2write pid) ns
diff --git a/src/Gargantext/Prelude.hs b/src/Gargantext/Prelude.hs
index a0afb7ec..8f973181 100644
--- a/src/Gargantext/Prelude.hs
+++ b/src/Gargantext/Prelude.hs
@@ -19,7 +19,7 @@ commentary with @some markup@.
module Gargantext.Prelude
( module Gargantext.Prelude
, module Protolude
- , headMay
+ , headMay, lastMay
, module Text.Show
, module Text.Read
, cs
@@ -31,7 +31,7 @@ module Gargantext.Prelude
import GHC.Exts (sortWith)
import Data.Maybe (isJust, fromJust, maybe)
-import Protolude ( Bool(True, False), Int, Double, Integer
+import Protolude ( Bool(True, False), Int, Int64, Double, Integer
, Fractional, Num, Maybe(Just,Nothing)
, Enum, Bounded, Float
, Floating, Char, IO
@@ -67,7 +67,7 @@ import qualified Data.Map as M
import Data.Map.Strict (insertWith)
import qualified Data.Vector as V
-import Safe (headMay)
+import Safe (headMay, lastMay)
import Text.Show (Show(), show)
import Text.Read (Read())
import Data.String.Conversions (cs)
--
2.21.0