[BASQHL] first basic function and todo list.

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))]
 

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
 

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

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)