Commit 35857fe1 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[WRONG] this type of refactoring fails in decodeJson

parent 9eaa8799
...@@ -27,7 +27,7 @@ import Gargantext.Database.Query.Table.User (insertUsersDemo) ...@@ -27,7 +27,7 @@ import Gargantext.Database.Query.Table.User (insertUsersDemo)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Trigger.Init (initTriggers) import Gargantext.Database.Admin.Trigger.Init (initTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata (HyperData)
import Gargantext.Database.Admin.Types.Node (CorpusId, RootId, ListId) import Gargantext.Database.Admin.Types.Node (CorpusId, RootId, ListId)
import Gargantext.Database.Prelude (Cmd, ) import Gargantext.Database.Prelude (Cmd, )
import Gargantext.Prelude import Gargantext.Prelude
...@@ -48,7 +48,7 @@ main = do ...@@ -48,7 +48,7 @@ main = do
let let
initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId) initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
initMaster = do initMaster = do
(masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus) (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) (Nothing :: Maybe HyperData)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
_triggers <- initTriggers masterListId _triggers <- initTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId) pure (masterUserId, masterRootId, masterCorpusId, masterListId)
......
...@@ -47,13 +47,13 @@ api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic ...@@ -47,13 +47,13 @@ api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
selectPublic :: HasNodeError err selectPublic :: HasNodeError err
=> Cmd err [( Node HyperdataFolder, Maybe Int)] => Cmd err [( Node HyperData, Maybe Int)]
selectPublic = selectPublicNodes selectPublic = selectPublicNodes
-- | For tests only -- | For tests only
-- pure $ replicate 6 defaultPublicData -- pure $ replicate 6 defaultPublicData
filterPublicDatas :: [( Node HyperdataFolder, Maybe Int)] -> [(Node HyperdataFolder, [NodeId])] filterPublicDatas :: [( Node HyperData, Maybe Int)] -> [(Node HyperData, [NodeId])]
filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
( _node_id n, (n, maybe [] (:[]) mi' )) ( _node_id n, (n, maybe [] (:[]) mi' ))
) datas ) datas
...@@ -62,7 +62,7 @@ filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in ...@@ -62,7 +62,7 @@ filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
& Map.elems & Map.elems
toPublicData :: (Node HyperdataFolder, [NodeId]) -> Maybe PublicData toPublicData :: (Node HyperData, [NodeId]) -> Maybe PublicData
toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title)) toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
<*> (hd ^? (_Just . hf_data . cf_desc)) <*> (hd ^? (_Just . hf_data . cf_desc))
<*> Just "images/Gargantextuel-212x300.jpg" <*> Just "images/Gargantextuel-212x300.jpg"
...@@ -73,7 +73,7 @@ toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title)) ...@@ -73,7 +73,7 @@ toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
where where
hd = head hd = head
$ filter (\(HyperdataField cd _ _) -> cd == JSON) $ filter (\(HyperdataField cd _ _) -> cd == JSON)
$ n^. (node_hyperdata . hc_fields) $ n^. (node_hyperdata . hd_fields)
data PublicData = PublicData data PublicData = PublicData
......
...@@ -99,7 +99,7 @@ type GargPrivateAPI' = ...@@ -99,7 +99,7 @@ type GargPrivateAPI' =
-- Corpus endpoints -- Corpus endpoints
:<|> "corpus" :> Summary "Corpus endpoint" :<|> "corpus" :> Summary "Corpus endpoint"
:> Capture "corpus_id" CorpusId :> Capture "corpus_id" CorpusId
:> NodeAPI HyperdataCorpus :> NodeAPI HyperData
:<|> "corpus" :> Summary "Corpus endpoint" :<|> "corpus" :> Summary "Corpus endpoint"
:> Capture "node1_id" NodeId :> Capture "node1_id" NodeId
...@@ -205,7 +205,7 @@ serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI' ...@@ -205,7 +205,7 @@ serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
= serverGargAdminAPI = serverGargAdminAPI
:<|> nodeAPI (Proxy :: Proxy HyperdataAny) uid :<|> nodeAPI (Proxy :: Proxy HyperdataAny) uid
:<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid :<|> nodeAPI (Proxy :: Proxy HyperData) uid
:<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid
:<|> Export.getCorpus -- uid :<|> Export.getCorpus -- uid
:<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid
......
...@@ -126,7 +126,7 @@ getDataText (InternalOrigin _) _la q _li = do ...@@ -126,7 +126,7 @@ getDataText (InternalOrigin _) _la q _li = do
(_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
(UserName userMaster) (UserName userMaster)
(Left "") (Left "")
(Nothing :: Maybe HyperdataCorpus) (Nothing :: Maybe HyperData)
ids <- map fst <$> searchInDatabase cId (stemIt q) ids <- map fst <$> searchInDatabase cId (stemIt q)
pure $ DataOld ids pure $ DataOld ids
...@@ -139,7 +139,7 @@ flowDataText :: FlowCmdM env err m ...@@ -139,7 +139,7 @@ flowDataText :: FlowCmdM env err m
-> m CorpusId -> m CorpusId
flowDataText u (DataOld ids) tt cid = flowCorpusUser (_tt_lang tt) u (Right [cid]) corpusType ids flowDataText u (DataOld ids) tt cid = flowCorpusUser (_tt_lang tt) u (Right [cid]) corpusType ids
where where
corpusType = (Nothing :: Maybe HyperdataCorpus) corpusType = (Nothing :: Maybe HyperData)
flowDataText u (DataNew txt) tt cid = flowCorpus u (Right [cid]) tt txt flowDataText u (DataNew txt) tt cid = flowCorpus u (Right [cid]) tt txt
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -177,7 +177,7 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a) ...@@ -177,7 +177,7 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
-> TermType Lang -> TermType Lang
-> [[a]] -> [[a]]
-> m CorpusId -> m CorpusId
flowCorpus = flow (Nothing :: Maybe HyperdataCorpus) flowCorpus = flow (Nothing :: Maybe HyperData)
flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c) flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
......
...@@ -117,10 +117,10 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume ...@@ -117,10 +117,10 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument] getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument) getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel] getListsModelWithParentId :: NodeId -> Cmd err [Node HyperData]
getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel) getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel)
getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus] getCorporaWithParentId :: NodeId -> Cmd err [Node HyperData]
getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus) getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -164,18 +164,18 @@ nodeContactW maybeName maybeContact aId = ...@@ -164,18 +164,18 @@ nodeContactW maybeName maybeContact aId =
name = maybe "Contact" identity maybeName name = maybe "Contact" identity maybeName
contact = maybe arbitraryHyperdataContact identity maybeContact contact = maybe arbitraryHyperdataContact identity maybeContact
------------------------------------------------------------------------ ------------------------------------------------------------------------
defaultFolder :: HyperdataCorpus defaultFolder :: HyperData
defaultFolder = defaultCorpus defaultFolder = defaultCorpus
nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite nodeFolderW :: Maybe Name -> Maybe HyperData -> ParentId -> UserId -> NodeWrite
nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid) nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
where where
name = maybe "Folder" identity maybeName name = maybe "Folder" identity maybeName
folder = maybe defaultFolder identity maybeFolder folder = maybe defaultFolder identity maybeFolder
------------------------------------------------------------------------ ------------------------------------------------------------------------
nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite nodeCorpusW :: Maybe Name -> Maybe HyperData -> ParentId -> UserId -> NodeWrite
nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId) nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
where where
name = maybe "Corpus" identity maybeName name = maybe "Corpus" identity maybeName
...@@ -251,6 +251,7 @@ nodeDefault nt parent = node nt name hyper (Just parent) ...@@ -251,6 +251,7 @@ nodeDefault nt parent = node nt name hyper (Just parent)
hyper = (hasDefaultData nt) hyper = (hasDefaultData nt)
------------------------------------------------------------------------ ------------------------------------------------------------------------
{-
arbitraryListModel :: HyperdataListModel arbitraryListModel :: HyperdataListModel
arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83) arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
...@@ -262,7 +263,7 @@ nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just ...@@ -262,7 +263,7 @@ nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just
where where
name = maybe "List Model" identity maybeName name = maybe "List Model" identity maybeName
list = maybe arbitraryListModel identity maybeListModel list = maybe arbitraryListModel identity maybeListModel
-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
arbitraryGraph :: HyperdataGraph arbitraryGraph :: HyperdataGraph
arbitraryGraph = HyperdataGraph Nothing arbitraryGraph = HyperdataGraph Nothing
...@@ -403,7 +404,7 @@ class MkCorpus a ...@@ -403,7 +404,7 @@ class MkCorpus a
where where
mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId] mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId]
instance MkCorpus HyperdataCorpus instance MkCorpus HyperData
where where
mk n h p u = insertNodesR [nodeCorpusW n h p u] mk n h p u = insertNodesR [nodeCorpusW n h p u]
......
...@@ -17,28 +17,27 @@ Portability : POSIX ...@@ -17,28 +17,27 @@ Portability : POSIX
module Gargantext.Viz.Phylo.API module Gargantext.Viz.Phylo.API
where where
import Data.String.Conversions import Control.Lens ((^?), _Just)
--import Control.Monad.Reader (ask)
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL
import Data.Proxy (Proxy(..)) import Data.Proxy (Proxy(..))
import Data.String.Conversions
import Data.Swagger import Data.Swagger
import Network.HTTP.Media ((//), (/:))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Web.HttpApiData (parseUrlPiece, readTextData)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.Types (TODO(..))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..)) import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith) import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
import Gargantext.Database.Schema.Node (_node_hyperdata) import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Phylo import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Main
import Gargantext.Viz.Phylo.Example import Gargantext.Viz.Phylo.Example
import Gargantext.Core.Types (TODO(..)) import Gargantext.Viz.Phylo.Main
import Network.HTTP.Media ((//), (/:))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Web.HttpApiData (parseUrlPiece, readTextData)
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL
------------------------------------------------------------------------ ------------------------------------------------------------------------
type PhyloAPI = Summary "Phylo API" type PhyloAPI = Summary "Phylo API"
...@@ -100,7 +99,7 @@ getPhylo phId _lId l msb = do ...@@ -100,7 +99,7 @@ getPhylo phId _lId l msb = do
let let
level = maybe 2 identity l level = maybe 2 identity l
branc = maybe 2 identity msb branc = maybe 2 identity msb
maybePhylo = hd_data $ _node_hyperdata phNode maybePhylo = phNode ^? ( node_hyperdata . hd_data . _Just)
p <- liftBase $ viewPhylo2Svg p <- liftBase $ viewPhylo2Svg
$ viewPhylo level branc $ viewPhylo level branc
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment