Commit 9533783a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Phylo] Code session Phylo

parent 6466fa7f
Pipeline #1163 failed with stage
...@@ -17,6 +17,7 @@ Portability : POSIX ...@@ -17,6 +17,7 @@ Portability : POSIX
module Gargantext.Core.Viz.Phylo.API module Gargantext.Core.Viz.Phylo.API
where where
import Data.Maybe (fromMaybe)
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.String.Conversions import Data.String.Conversions
--import Control.Monad.Reader (ask) --import Control.Monad.Reader (ask)
...@@ -98,13 +99,13 @@ getPhylo :: PhyloId -> GargServer GetPhylo ...@@ -98,13 +99,13 @@ getPhylo :: PhyloId -> GargServer GetPhylo
getPhylo phId _lId l msb = do getPhylo phId _lId l msb = do
phNode <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo) phNode <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
let let
level = maybe 2 identity l level = fromMaybe 2 l
branc = maybe 2 identity msb branc = fromMaybe 2 msb
maybePhylo = phNode ^. (node_hyperdata . hp_data) maybePhylo = phNode ^. (node_hyperdata . hp_data)
p <- liftBase $ viewPhylo2Svg p <- liftBase $ viewPhylo2Svg
$ viewPhylo level branc $ viewPhylo level branc
$ maybe phyloFromQuery identity maybePhylo $ fromMaybe phyloFromQuery maybePhylo
pure (SVG p) pure (SVG p)
------------------------------------------------------------------------ ------------------------------------------------------------------------
type PostPhylo = QueryParam "listId" ListId type PostPhylo = QueryParam "listId" ListId
...@@ -112,16 +113,16 @@ type PostPhylo = QueryParam "listId" ListId ...@@ -112,16 +113,16 @@ type PostPhylo = QueryParam "listId" ListId
:> (Post '[JSON] NodeId) :> (Post '[JSON] NodeId)
postPhylo :: CorpusId -> UserId -> GargServer PostPhylo postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
postPhylo n userId _lId = do postPhylo corpusId userId _lId = do
-- TODO get Reader settings -- TODO get Reader settings
-- s <- ask -- s <- ask
-- let -- let
-- _vrs = Just ("1" :: Text) -- _vrs = Just ("1" :: Text)
-- _sft = Just (Software "Gargantext" "4") -- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q) -- _prm = initPhyloParam vrs sft (Just q)
phy <- flowPhylo n phy <- flowPhylo corpusId -- params
pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId] phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
pure $ NodeId (fromIntegral pId) pure $ NodeId (fromIntegral phyloId)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | DELETE Phylo == delete a node -- | DELETE Phylo == delete a node
......
...@@ -37,6 +37,17 @@ import qualified Data.Set as Set ...@@ -37,6 +37,17 @@ import qualified Data.Set as Set
-- | To Phylo | -- -- | To Phylo | --
------------------ ------------------
{-
-- TODO AD
data Phylo' = PhyloBase { _phylo'_phyloBase :: Phylo}
| PhyloN { _phylo'_phylo1 :: Phylo}
toPhylo' :: Phylo' -> [Document] -> TermList -> Config -> Phylo
toPhylo' (PhyloN phylo) = toPhylo'
toPhylo' (PhyloBase phylo) = toPhylo
-}
toPhylo :: [Document] -> TermList -> Config -> Phylo toPhylo :: [Document] -> TermList -> Config -> Phylo
toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFromLevel 1 phylo1)) toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFromLevel 1 phylo1))
...@@ -48,9 +59,11 @@ toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFrom ...@@ -48,9 +59,11 @@ toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFrom
-------------------------------------- --------------------------------------
phylo1 :: Phylo phylo1 :: Phylo
phylo1 = toPhylo1 docs phyloBase phylo1 = toPhylo1 docs phyloBase
-- > AD to db here
-------------------------------------- --------------------------------------
phyloBase :: Phylo phyloBase :: Phylo
phyloBase = toPhyloBase docs lst conf phyloBase = toPhyloBase docs lst conf
-- > AD to db here
-------------------------------------- --------------------------------------
......
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