NodeAPI /roots, /node

src/Data/Gargantext/Database/Node.hs

@@ -19,14 +19,14 @@ import Database.PostgreSQL.Simple.Internal  (Field)
 import Control.Arrow (returnA)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Aeson
-import Data.Gargantext.Database.Private (infoGargandb)
 import Data.Gargantext.Types
-import Data.Maybe (Maybe)
+import Data.Gargantext.Prelude
+import Data.Maybe (Maybe, fromMaybe)
 import Data.Text (Text)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Typeable (Typeable)
 import qualified Data.ByteString.Internal as DBI
-import qualified Database.PostgreSQL.Simple as PGS
+import Database.PostgreSQL.Simple (Connection)
 import Opaleye
 
 -- | Types for Node Database Management
@@ -105,13 +105,13 @@ nodeTable = Table "nodes" (pNode Node { node_id                = optional "id"
                             )
 
 
-selectNodes :: Column PGInt4 -> Query (Column (PGText))
-selectNodes node_id = proc () -> do
-    (Node n_id _tn _u _p n _d _h ) <- queryNodeTable -< ()
-    restrict -< n_id .== node_id
-    returnA -< n
+selectNodes :: Column PGInt4 -> Query NodeRead
+selectNodes id = proc () -> do
+    row <- queryNodeTable -< ()
+    restrict -< node_id row .== id
+    returnA -< row
 
-runGetNodes :: PGS.Connection -> Query NodeRead -> IO [Document]
+runGetNodes :: Connection -> Query NodeRead -> IO [Document]
 runGetNodes = runQuery
 
 
@@ -122,6 +122,7 @@ queryNodeTable = queryTable nodeTable
 selectNodeWithParentID :: Column (Nullable PGInt4) -> Query NodeRead
 selectNodeWithParentID node_id = proc () -> do
     row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
+    -- restrict -< maybe (isNull p_id) (p_id .==) node_id
     restrict -< p_id .== node_id
     returnA -< row
 
@@ -129,25 +130,26 @@ selectNodesWithType :: Column PGInt4 -> Query NodeRead
 selectNodesWithType type_id = proc () -> do
     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
     restrict -< tn .== type_id
-    --let noParent = ifThenElse (isNull nullableBoss) (pgString "no") (pgString "a")
-    --returnA -< Node _id _tn _uid (pgInt4 0) (pgString "") _d _h
     returnA -< row
 
-getNodesWithType :: Column PGInt4 -> IO [NodeUser]
-getNodesWithType type_id = do
-    conn <- PGS.connect infoGargandb
+getNode :: Connection -> Column PGInt4 -> IO (Node Value)
+getNode conn id = do
+    fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes id)
+
+getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
+getNodesWithType conn type_id = do
     runQuery conn $ selectNodesWithType type_id
 
-getNodesWithParentId :: Column (Nullable PGInt4) -> IO [Document]
-getNodesWithParentId node_id = do
-    conn <- PGS.connect infoGargandb
+-- NP check type
+getNodesWithParentId :: Connection -> Column (Nullable PGInt4) -> IO [Node Value]
+getNodesWithParentId conn node_id = do
     runQuery conn $ selectNodeWithParentID node_id
 
-getCorpusDocument :: Column (Nullable PGInt4) -> IO [Document]
-getCorpusDocument node_id = PGS.connect infoGargandb >>=
-                          \conn -> runQuery conn (selectNodeWithParentID node_id)
+-- NP check type
+getCorpusDocument :: Connection -> Column PGInt4 -> IO [Document]
+getCorpusDocument conn node_id = runQuery conn (selectNodeWithParentID $ toNullable node_id)
 
-getProjectCorpora :: Column (Nullable PGInt4) -> IO [Corpus]
-getProjectCorpora node_id = do
-    conn <- PGS.connect infoGargandb
+-- NP check type
+getProjectCorpora :: Connection -> Column (Nullable PGInt4) -> IO [Corpus]
+getProjectCorpora conn node_id = do
     runQuery conn $ selectNodeWithParentID node_id

src/Data/Gargantext/Parsers/Date.hs

@@ -53,6 +53,10 @@ import Safe (headMay)
 
 
 -- | Final Date parser API
+-- IO can be avoided here:
+-- currentContext :: Lang -> IO Context
+-- currentContext lang = localContext lang <$> utcToDucklingTime <$> getCurrentTime
+-- parseDate1 :: Context -> Text -> SomeErrorHandling Text
 parseDate1 :: Lang -> Text -> IO Text
 parseDate1 lang text = do
     maybeJson <- pm jsonValue <$> parseDateWithDuckling lang text

src/Data/Gargantext/Prelude.hs

@@ -6,7 +6,12 @@
 TODO: import head impossible from Protolude: why ?
 -}
 
-module Data.Gargantext.Prelude where
+module Data.Gargantext.Prelude
+  ( module Data.Gargantext.Prelude
+  , module Protolude
+  , headMay
+  )
+  where
 
 import Protolude ( Bool(True, False), Int, Double, Integer
                  , Fractional, Num, Maybe, Floating, Char
@@ -26,7 +31,7 @@ import qualified Data.List     as L hiding (head, sum)
 import qualified Control.Monad as M
 import qualified Data.Map as Map
 import qualified Data.Vector as V
--- import Safe (headMay)
+import Safe (headMay)
 
 
 pf :: (a -> Bool) -> [a] -> [a]

src/Data/Gargantext/Server.hs

@@ -8,42 +8,48 @@ module Data.Gargantext.Server
 --    )
       where
 
+import Prelude hiding (null)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Aeson
-import Data.Aeson.TH
 import Network.Wai
 import Network.Wai.Handler.Warp
 import Servant
 import Servant.Multipart
+import Database.PostgreSQL.Simple (Connection, connect)
+import Opaleye
 
--- | TODO, use MOCK feature of Servant to generate fake data (for tests)
+import Data.Gargantext.Types.Main (Node, NodeId)
+import Data.Gargantext.Database.Node (getNodesWithParentId, getNode)
+import Data.Gargantext.Database.Private (infoGargandb)
 
-data FakeNode = FakeNode
-  { fakeNodeId        :: Int
-  , fakeNodeName      :: String
-  } deriving (Eq, Show)
+-- | TODO, use MOCK feature of Servant to generate fake data (for tests)
 
-$(deriveJSON defaultOptions ''FakeNode)
+type NodeAPI = Get '[JSON] (Node Value)
+           :<|> "children" :> Get '[JSON] [Node Value]
 
-type API = "nodes"   :> Get '[JSON] [FakeNode]
-       :<|> "node"   :> Capture "id" Int            :> Get '[JSON] FakeNode
+type API =  "roots"  :> Get '[JSON] [Node Value]
+       :<|> "node"   :> Capture "id" Int :> NodeAPI
        :<|> "echo"   :> Capture "string" String     :> Get '[JSON] String
        :<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] String
 
        -- :<|> "node"  :> Capture "id" Int        :> Get '[JSON] Node
 
-server :: Server API
-server = pure fakeNodes
-        :<|> fakeNode
-        :<|> echo
-        :<|> upload
+server :: Connection -> Server API
+server conn
+    = liftIO (getNodesWithParentId conn null)
+  :<|> nodeAPI conn
+  :<|> echo
+  :<|> upload
     where
         echo s = pure s
 
 
 startGargantext :: IO ()
-startGargantext = print ("Starting server on port " ++ show port)  >> run port app
+startGargantext = do
+  print ("Starting server on port " ++ show port)
+  conn <- connect infoGargandb
+  run port $ app conn
     where
         port = 8008
 
@@ -54,20 +60,17 @@ startGargantext = print ("Starting server on port " ++ show port)  >> run port a
 --                 , MonadLog (WithSeverity Doc) m
 --                 , MonadIO m) => m a
 -- Thanks @yannEsposito for this.
-app :: Application
-app = serve api server
+app :: Connection -> Application
+app = serve api . server
 
 api :: Proxy API
 api = Proxy
 
-
-fakeNode :: Monad m => Int -> m FakeNode
-fakeNode id = pure (fakeNodes !! id)
-
-fakeNodes :: [FakeNode]
-fakeNodes = [ FakeNode 1 "Poincare"
-            , FakeNode 2 "Grothendieck"
-            ]
+nodeAPI :: Connection -> NodeId -> Server NodeAPI
+nodeAPI conn id
+    =  liftIO (getNode conn id')
+  :<|> liftIO (getNodesWithParentId conn (toNullable id'))
+       where id' = pgInt4 id
 
 -- | Upload files
 -- TODO Is it possible to adapt the function according to iValue input ?

src/Data/Gargantext/Types/Main.hs

@@ -33,34 +33,43 @@ data Language = EN | FR -- | DE | IT | SP
 
 
 -- All the Database is structred like a hierarchical Tree
-data Tree b a = LeafT a | NodeT b [Tree b a]
+data Tree a = NodeT a [Tree a]
               deriving (Show, Read, Eq)
 
+
+-- data Tree a = NodeT a [Tree a]
+-- same as Data.Tree
+leafT :: a -> Tree a
+leafT x = NodeT x []
+
 -- Garg Network is a network of all Garg nodes
 --gargNetwork = undefined
 
 -- | Garg Node is Database Schema Typed as specification
 -- gargNode gathers all the Nodes of all users on one Node
-gargNode :: [Tree NodeType NodeType]
+gargNode :: [Tree NodeType]
 gargNode = [userTree]
 
 -- | User Tree simplified
-userTree :: Tree NodeType NodeType
+userTree :: Tree NodeType
 userTree = NodeT NodeUser [projectTree]
 
 -- | Project Tree
-projectTree :: Tree NodeType NodeType
+projectTree :: Tree NodeType
 projectTree = NodeT Project [corpusTree]
 
 -- | Corpus Tree
-corpusTree :: Tree NodeType NodeType
-corpusTree = NodeT Corpus (  [ LeafT Document ]
-                          <> [ LeafT Lists    ]
-                          <> [ LeafT Metrics  ]
-                          <> [ LeafT Classification]
+corpusTree :: Tree NodeType
+corpusTree = NodeT Corpus (  [ leafT Document ]
+                          <> [ leafT Lists    ]
+                          <> [ leafT Metrics  ]
+                          <> [ leafT Classification]
                           )
 
 --   TODO make instances of Nodes
+-- NP
+-- * why NodeUser and not just User ?
+-- * is this supposed to hold data ?
 data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
               | Classification
               | Lists
@@ -91,7 +100,7 @@ type NodeName     = Text
 -- | Then a Node can be either a Folder or a Corpus or a Document
 type NodeUser = Node HyperdataUser
 type Folder   = Node HyperdataFolder
-type Project  = Folder
+type Project  = Folder -- NP Node HyperdataProject ?
 type Corpus   = Node HyperdataCorpus
 type Document = Node HyperdataDocument
 
@@ -105,14 +114,14 @@ type Favorites = Node HyperdataFavorites
 -- | Favorites Node enable Swap Node with some synonyms for clarity
 type NodeSwap  = Node HyperdataResource
 
--- | Then a Node can be a List which as some synonyms
+-- | Then a Node can be a List which has some synonyms
 type List = Node HyperdataList
 type StopList   = List
 type MainList   = List
 type MapList    = List
 type GroupList  = List
 
--- | Then a Node can be a Score which as some synonyms
+-- | Then a Node can be a Score which has some synonyms
 type Score = Node HyperdataScore
 type Occurrences   = Score
 type Cooccurrences = Score

src/Data/Gargantext/Types/Node.hs

@@ -10,6 +10,7 @@ import Data.Time (UTCTime)
 import Data.Gargantext.Utils.Prefix (unPrefix)
 import Data.Aeson.TH (deriveJSON)
 
+-- node_Id... ?
 data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
                                                                      , node_typename  :: typename
                                                                      , node_userId    :: userId
@@ -20,6 +21,7 @@ data NodePoly id typename userId parentId name date hyperdata = Node { node_id
                                                                      , node_hyperdata :: hyperdata
                                                               --       , node_titleAbstract :: titleAbstract
                                                                      } deriving (Show)
+$(deriveJSON (unPrefix "node_") ''NodePoly)
 
 
 data Status  = Status { status_Date     :: Maybe UTCTime
@@ -77,6 +79,7 @@ data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 
+-- Preferences ?
 
 data HyperdataFolder = HyperdataFolder { hyperdataFolder_Preferences   :: Maybe Text
                                        } deriving (Show, Generic)