[MOCK] all routes completed, builds but need to be adapted to fite the practices.

gargantext.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 14b119af3791906ac7f3c681c0b20b5c475078386862e0d14ce3d98919c90d85
+-- hash: 09c6aeeafdac8e64c7203c8d663937d4240ca86e9556a3371567cc1579eafd59
 
 name:           gargantext
 version:        0.1.0.0
@@ -37,6 +37,7 @@ library
     , conduit-extra
     , containers
     , contravariant
+    , data-time-segment
     , directory
     , duckling
     , extra

package.yaml

@@ -71,6 +71,7 @@ library:
   - conduit-extra
   - containers
   - contravariant
+  - data-time-segment
   - directory
   - duckling
   - filepath

src/Gargantext/API.hs

@@ -19,10 +19,13 @@ Thanks @yannEsposito for this.
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 {-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators   #-}
 {-# LANGUAGE DeriveGeneric   #-}
+{-# LANGUAGE FlexibleInstances           #-}
+{-# LANGUAGE TypeOperators   #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings           #-}
 
 module Gargantext.API
       where
@@ -73,7 +76,7 @@ startGargantextMock port = do
         <> show port 
         <>"/count"
          )
-  run port ( serve apiMock $ mock apiMock Proxy )
+  run port ( serve api $ mock api Proxy )
 
 ---------------------------------------------------------------------
 ---------------------------------------------------------------------
@@ -84,9 +87,8 @@ type API =  "roots"  :> Roots
        :<|> "node"   :> Capture "id" Int      :> NodeAPI
        :<|> "nodes"  :> ReqBody '[JSON] [Int] :> NodesAPI
        
-       :<|> APIMock
        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
-type APIMock = "count"  :> ReqBody '[JSON] Query :> CountAPI 
+       :<|> "count"  :> ReqBody '[JSON] Query :> CountAPI 
 
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
@@ -111,8 +113,6 @@ app = serve api . server
 
 api :: Proxy API
 api = Proxy
-
-apiMock :: Proxy APIMock
-apiMock = Proxy
-
+---------------------------------------------------------------------
+---------------------------------------------------------------------
 

src/Gargantext/API/Count.hs

@@ -16,6 +16,7 @@ Count API part of Gargantext.
 {-# LANGUAGE TypeOperators               #-}
 {-# LANGUAGE DeriveGeneric               #-}
 {-# LANGUAGE DeriveAnyClass              #-}
+{-# LANGUAGE OverloadedStrings           #-}
 
 module Gargantext.API.Count
       where
@@ -30,7 +31,7 @@ import GHC.Generics (Generic)
 import Data.Aeson hiding (Error)
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
-import Data.List (repeat,permutations)
+import Data.List (permutations)
 -----------------------------------------------------------------------
 type CountAPI = Post '[JSON] Counts
 
@@ -78,15 +79,15 @@ instance Arbitrary Query where
 
 -----------------------------------------------------------------------
 -----------------------------------------------------------------------
-
+type Code = Integer
 type Error  = Text
 type Errors = [Error]
 
-data Message = Message Integer Errors
+data Message = Message Code Errors
         deriving (Eq, Show, Generic)
 
-toMessage :: [(Integer, [Text])] -> [Message]
-toMessage = map (\(c,es) -> Message c es)
+toMessage :: [(Code, Errors)] -> [Message]
+toMessage = map (\(c,err) -> Message c err)
 
 messages :: [Message]
 messages =  toMessage $ [ (400, ["Ill formed query             "])
@@ -94,7 +95,7 @@ messages =  toMessage $ [ (400, ["Ill formed query             "])
                         , (300, ["Internal Gargantext Error    "])
                         , (300, ["Connexion to Gargantext Error"])
                         , (300, ["Token has expired            "])
-                        ] <> take 10 ( repeat (200, [""]))
+                        ] -- <> take 10 ( repeat (200, [""]))
 
 instance Arbitrary Message where
     arbitrary = elements messages

src/Gargantext/API/Node.hs

@@ -14,6 +14,7 @@ Node API
 {-# LANGUAGE DataKinds       #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators   #-}
+{-# LANGUAGE OverloadedStrings           #-}
 
 module Gargantext.API.Node
       where
@@ -27,13 +28,15 @@ import Data.Text (Text())
 --import Data.Text (Text(), pack)
 import Database.PostgreSQL.Simple (Connection)
 import Gargantext.Prelude
-import Gargantext.Types.Main (Node, NodeId, NodeType)
+import Gargantext.Types.Node
+
 import Gargantext.Database.Node (getNodesWithParentId
                                 , getNode, getNodesWith
                                 , deleteNode, deleteNodes)
 import Gargantext.Database.Facet (FacetDoc, getDocFacet)
 
 
+
 -- | Node API Types management
 type Roots = Get '[JSON] [Node Value]
 
@@ -60,7 +63,7 @@ type NodeAPI   = Get '[JSON] (Node Value)
              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
                 
                 -- To launch a query and update the corpus
-             :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
+             -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
 
 
 
@@ -74,7 +77,7 @@ nodeAPI conn id =  liftIO (getNode              conn id)
               :<|> getNodesWith' conn id
               :<|> getDocFacet'  conn id
               -- :<|> upload
-              :<|> query
+              -- :<|> query
 
 nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 nodesAPI conn ids = deleteNodes' conn ids

src/Gargantext/Database/Facet.hs

@@ -23,7 +23,7 @@ module Gargantext.Database.Facet where
 import Prelude hiding (null, id, map, sum, not)
 
 import Gargantext.Types
-import Gargantext.Types.Main (NodeType)
+import Gargantext.Types.Node (NodeType)
 import Gargantext.Database.NodeNode
 import Gargantext.Database.NodeNodeNgram
 import Gargantext.Database.Node
@@ -45,6 +45,12 @@ import Opaleye.Internal.Join (NullMaker)
 import qualified Opaleye.Internal.Unpackspec()
 import Data.Profunctor.Product.Default (Default)
 
+import Data.Time.Segment (jour)
+
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck (elements)
+
+
 -- DocFacet
 
 type FacetDoc = Facet NodeId UTCTime HyperdataDocument Bool -- Double
@@ -58,7 +64,13 @@ data Facet id created hyperdata favorite  = FacetDoc { facetDoc_id :: id
                                                        } deriving (Show)
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
 
-
+instance Arbitrary FacetDoc where
+    arbitrary = elements [ FacetDoc id' (jour year 01 01) hp fav 
+                         | id'  <- [1..10]
+                         , year <- [1990..2000]
+                         , fav  <- [True, False]
+                         , hp   <- hyperdataDocuments
+                         ]
 
 -- Facets / Views for the Front End
 type FacetDocRead  = Facet (Column PGInt4) (Column PGTimestamptz) (Column PGJsonb) (Column PGBool) -- (Column PGFloat8)

src/Gargantext/Database/Node.hs

@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
 import Prelude hiding (null, id, map, sum)
 
 import Gargantext.Types
-import Gargantext.Types.Main (NodeType)
+import Gargantext.Types.Node (NodeType)
 import Gargantext.Database.Queries
 import Gargantext.Prelude hiding (sum)
 

src/Gargantext/Types/Main.hs

@@ -10,8 +10,12 @@ Portability : POSIX
 Here is a longer description of this module, containing some
 commentary with @some markup@.
 -}
-{-# LANGUAGE FlexibleInstances #-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 {-# LANGUAGE DeriveGeneric               #-}
+{-# LANGUAGE FlexibleInstances           #-}
+{-# LANGUAGE OverloadedStrings           #-}
 
 module Gargantext.Types.Main where
 
@@ -20,24 +24,10 @@ import Prelude
 import Data.Eq (Eq())
 import Data.Monoid ((<>))
 import Protolude (fromMaybe)
-import Data.Aeson
-import GHC.Generics
-import Servant
-import Data.Text (unpack)
-import Text.Read (read)
-import Data.Either (Either(Right))
 --import Data.ByteString (ByteString())
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.List (lookup)
-import Gargantext.Types.Node ( NodePoly, HyperdataUser
-                               , HyperdataFolder   , HyperdataCorpus   , HyperdataDocument
-                               , HyperdataFavorites, HyperdataResource
-                               , HyperdataList  , HyperdataScore
-                               , HyperdataGraph
-                               , HyperdataPhylo
-                               , HyperdataNotebook
-                               )
+import Gargantext.Types.Node
 
 
 -- | Language of a Text
@@ -89,15 +79,7 @@ corpusTree = NodeT Corpus (  [ leafT Document ]
 -- NP
 -- * why NodeUser and not just User ?
 -- * is this supposed to hold data ?
-data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
-              | Classification
-              | Lists
-              | Metrics | Occurrences
-              deriving (Show, Read, Eq, Generic)
 
-instance FromJSON NodeType
-instance ToJSON NodeType
-instance FromHttpApiData NodeType where parseUrlPiece = Right . read . unpack
 
 data Classification = Favorites | MyClassifcation
 
@@ -107,27 +89,6 @@ data Lists  =  StopList    | MainList | MapList | GroupList
 --              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal
 
 
-
--- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
-
--- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
-type NodeTypeId   = Int
-type NodeId       = Int
-type NodeParentId = Int
-type NodeUserId   = Int
-type NodeName     = Text
---type NodeVector   = Vector
-
---type NodeUser    = Node HyperdataUser
-
--- | 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 -- NP Node HyperdataProject ?
-type Corpus   = Node HyperdataCorpus
-type Document = Node HyperdataDocument
-
 -- | Community Manager Use Case
 type Annuaire  = Corpus
 type Individu  = Document

src/Gargantext/Types/Node.hs

-{-# LANGUAGE TemplateHaskell #-}
+{-|
+Module      : Gargantext.Types.Nodes
+Description : Main Types of Nodes
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
 {-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE FlexibleInstances  #-}
+
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
 module Gargantext.Types.Node where
@@ -7,28 +21,26 @@ module Gargantext.Types.Node where
 import Gargantext.Prelude
 
 import Text.Show (Show())
-import Data.Text (Text)
+import Data.Text (Text, unpack)
+import Text.Read (read)
 import GHC.Generics (Generic)
+import Data.Eq (Eq)
 import Data.Time (UTCTime)
 import Gargantext.Utils.Prefix (unPrefix)
 import Data.Aeson.TH (deriveJSON)
+import Data.Aeson
+import Servant
+import Data.Either
 
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck (elements)
 
-
--- node_Id... ?
-data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
-                                                                     , node_typename  :: typename
-                                                                     , node_userId    :: userId
-                                                                --   , nodeHashId    :: hashId
-                                                                     , node_parentId  :: parentId
-                                                                     , node_name      :: name
-                                                                     , node_date      :: date
-                                                                     , node_hyperdata :: hyperdata
-                                                              --       , node_titleAbstract :: titleAbstract
-                                                                     } deriving (Show)
-$(deriveJSON (unPrefix "node_") ''NodePoly)
+-- Instances:
+import Data.Time.Segment (jour)
+import Data.Aeson (Value(),toJSON)
 
 
+------------------------------------------------------------------------
 data Status  = Status { status_Date     :: Maybe UTCTime
                       , status_Error    :: Maybe Text
                       , status_Action   :: Maybe Text
@@ -37,7 +49,11 @@ data Status  = Status { status_Date     :: Maybe UTCTime
                       } deriving (Show, Generic)
 $(deriveJSON (unPrefix "status_") ''Status)
 
+instance Arbitrary Status where
+    arbitrary = elements [Status Nothing Nothing Nothing Nothing Nothing]
+
 
+------------------------------------------------------------------------
 data HyperdataDocument = HyperdataDocument { hyperdataDocument_Bdd                :: Maybe Text
                                            , hyperdataDocument_Doi                :: Maybe Text
                                            , hyperdataDocument_Url                :: Maybe Text
@@ -56,11 +72,24 @@ data HyperdataDocument = HyperdataDocument { hyperdataDocument_Bdd
                                            } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataDocument_") ''HyperdataDocument)
 
+hyperdataDocuments :: [HyperdataDocument]
+hyperdataDocuments = [HyperdataDocument Nothing Nothing Nothing Nothing (Just "Title") 
+                                            Nothing (Just "Abstract") Nothing Nothing 
+                                            Nothing Nothing Nothing Nothing Nothing Nothing
+                         ]
+
+
+instance Arbitrary HyperdataDocument where
+    arbitrary = elements hyperdataDocuments
+
+------------------------------------------------------------------------
 data LanguageNodes = LanguageNodes { languageNodes___unknown__ :: [Int]}
     deriving (Show, Generic)
 $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
 
 
+------------------------------------------------------------------------
+
 data Resource = Resource { resource_Url  :: Maybe Text
                          , resource_Path :: Maybe Text
                          , resource_Type :: Maybe Int
@@ -68,6 +97,8 @@ data Resource = Resource { resource_Url  :: Maybe Text
                          } deriving (Show, Generic)
 $(deriveJSON (unPrefix "resource_") ''Resource)
 
+instance Arbitrary Resource where
+    arbitrary = elements [Resource Nothing Nothing Nothing Nothing]
 
 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_Action       :: Maybe Text
                                        , hyperdataCorpus_Statuses     :: Maybe [Status]
@@ -79,7 +110,6 @@ data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_Action       :: Maybe T
 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 
 
-
 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
@@ -135,4 +165,56 @@ $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 
 
 
+-- | NodePoly indicates that Node has a Polymorphism Type
+type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
+
+-- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
+type NodeTypeId   = Int
+type NodeId       = Int
+type NodeParentId = Int
+type NodeUserId   = Int
+type NodeName     = Text
+--type NodeVector   = Vector
+
+--type NodeUser    = Node HyperdataUser
+
+-- | 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 -- NP Node HyperdataProject ?
+type Corpus   = Node HyperdataCorpus
+type Document = Node HyperdataDocument
+
+data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
+              | Classification
+              | Lists
+              | Metrics | Occurrences
+              deriving (Show, Read, Eq, Generic)
+
+instance FromJSON NodeType
+instance ToJSON NodeType
+instance FromHttpApiData NodeType where parseUrlPiece = Right . read . unpack
+
+
+------------------------------------------------------------------------
+data NodePoly id typename userId parentId name date hyperdata = Node { node_id        :: id
+                                                                     , node_typename  :: typename
+                                                                     , node_userId    :: userId
+                                                                --   , nodeHashId    :: hashId
+                                                                     , node_parentId  :: parentId
+                                                                     , node_name      :: name
+                                                                     , node_date      :: date
+                                                                     , node_hyperdata :: hyperdata
+                                                              --       , node_titleAbstract :: titleAbstract
+                                                                     } deriving (Show)
+$(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))]
+
+
+instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime Value) where
+    arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) (toJSON ("{}"::Text))]
+
+
 

stack.yaml

@@ -4,6 +4,8 @@ packages:
 - .
 allow-newer: true
 extra-deps:
+- git: git@github.com:delanoe/data-time-segment.git
+  commit: 4e3d57d80e9dfe6624c8eeaa8595fc8fe64d8723
 - aeson-0.11.3.0
 - aeson-lens-0.5.0.0
 - duckling-0.1.3.0