Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext...
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / API.hs
index 8afcf55dff4f04cab3e7e991f1f0012b3889b71f..a73dbecd27a86e51ae2147d963f4ed20cd31568c 100644 (file)
@@ -17,6 +17,7 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.API
   where
 
+import Data.Maybe (fromMaybe)
 import Control.Lens ((^.))
 import Data.String.Conversions
 --import Control.Monad.Reader (ask)
@@ -98,13 +99,13 @@ getPhylo :: PhyloId -> GargServer GetPhylo
 getPhylo phId _lId l msb  = do
   phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
   let
-    level = maybe 2 identity l
-    branc = maybe 2 identity msb
+    level = fromMaybe 2 l
+    branc = fromMaybe 2 msb
     maybePhylo = phNode ^. (node_hyperdata . hp_data)
 
   p <- liftBase $ viewPhylo2Svg
                 $ viewPhylo level branc
-                $ maybe phyloFromQuery identity maybePhylo
+                $ fromMaybe phyloFromQuery maybePhylo
   pure (SVG p)
 ------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
@@ -112,16 +113,16 @@ type PostPhylo =  QueryParam "listId" ListId
                :> (Post '[JSON] NodeId)
 
 postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
-postPhylo n userId _lId = do
+postPhylo corpusId userId _lId = do
   -- TODO get Reader settings
   -- s <- ask
-  let
+  -- let
     -- _vrs = Just ("1" :: Text)
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
-  phy  <- flowPhylo n
-  pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
-  pure $ NodeId (fromIntegral pId)
+  phy <- flowPhylo corpusId -- params
+  phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
+  pure $ NodeId (fromIntegral phyloId)
 
 ------------------------------------------------------------------------
 -- | DELETE Phylo == delete a node
@@ -136,64 +137,25 @@ putPhylo = undefined
 
 
 -- | Instances
-instance Arbitrary PhyloView
-  where
-    arbitrary = elements [phyloView]
-
--- | TODO add phyloGroup ex
-instance Arbitrary PhyloGroup
-  where
-    arbitrary = elements []
-
-instance Arbitrary Phylo
-  where
-    arbitrary = elements [phylo]
-
-instance ToSchema Order
-
-instance ToParamSchema Order
-instance FromHttpApiData Order
-  where
-    parseUrlPiece = readTextData
-
-
-instance ToParamSchema Metric
-instance FromHttpApiData [Metric]
-  where
-    parseUrlPiece = readTextData
-instance FromHttpApiData Metric
-  where
-    parseUrlPiece = readTextData
-
-
+instance Arbitrary Phylo             where arbitrary     = elements [phylo]
+instance Arbitrary PhyloGroup        where arbitrary     = elements []
+instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
+instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData
+instance FromHttpApiData ExportMode  where parseUrlPiece = readTextData
+instance FromHttpApiData Filiation   where parseUrlPiece = readTextData
+instance FromHttpApiData Metric      where parseUrlPiece = readTextData
+instance FromHttpApiData Order       where parseUrlPiece = readTextData
+instance FromHttpApiData Sort        where parseUrlPiece = readTextData
+instance FromHttpApiData Tagger      where parseUrlPiece = readTextData
+instance FromHttpApiData [Metric]    where parseUrlPiece = readTextData
+instance FromHttpApiData [Tagger]    where parseUrlPiece = readTextData
 instance ToParamSchema   DisplayMode
-instance FromHttpApiData DisplayMode
-  where
-    parseUrlPiece = readTextData
-
-
 instance ToParamSchema   ExportMode
-instance FromHttpApiData ExportMode
-  where
-    parseUrlPiece = readTextData    
-
-
-instance FromHttpApiData Sort
-  where
-    parseUrlPiece = readTextData
-instance ToParamSchema Sort
-
-instance FromHttpApiData [Tagger]
-  where
-    parseUrlPiece = readTextData
-instance FromHttpApiData Tagger
-  where
-    parseUrlPiece = readTextData
-instance ToParamSchema   Tagger
-
-instance FromHttpApiData Filiation
-  where
-    parseUrlPiece = readTextData
 instance ToParamSchema   Filiation
+instance ToParamSchema   Tagger
+instance ToParamSchema Metric
+instance ToParamSchema Order
+instance ToParamSchema Sort
+instance ToSchema Order