[nodeStory] add immediate saver
[gargantext.git] / src / Gargantext / Core / Viz / Phylo / API.hs
index a73dbecd27a86e51ae2147d963f4ed20cd31568c..019dab03caaca6dd98fb8afbd78114771f561190 100644 (file)
@@ -17,29 +17,30 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.API
   where
 
+import GHC.Generics (Generic)
+import Data.Aeson
+import Data.Either
 import Data.Maybe (fromMaybe)
-import Control.Lens ((^.))
-import Data.String.Conversions
---import Control.Monad.Reader (ask)
-import qualified Data.ByteString as DB
-import qualified Data.ByteString.Lazy as DBL
 import Data.Swagger
+import Gargantext.API.Prelude
+import Gargantext.Core.Types (TODO(..))
+import Gargantext.Core.Viz.LegacyPhylo
+import Gargantext.Core.Viz.Phylo (defaultConfig)
+import Gargantext.Core.Viz.Phylo.API.Tools
+import Gargantext.Core.Viz.Phylo.Example (phyloExample)
+import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
+import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, defaultList)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Prelude
 import Network.HTTP.Media ((//), (/:))
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Web.HttpApiData (readTextData)
-
-import Gargantext.API.Prelude
-import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
-import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
-import Gargantext.Database.Schema.Node (node_hyperdata)
-import Gargantext.Prelude
-import Gargantext.Core.Viz.Phylo
-import Gargantext.Core.Viz.Phylo.Main
-import Gargantext.Core.Viz.Phylo.Example
-import Gargantext.Core.Types (TODO(..))
+import qualified Data.ByteString as DB
+import qualified Data.ByteString.Lazy as DBL
 
 ------------------------------------------------------------------------
 type PhyloAPI = Summary "Phylo API"
@@ -55,24 +56,28 @@ phyloAPI n u = getPhylo  n
         -- :<|> deletePhylo  n
 
 newtype SVG = SVG DB.ByteString
+--instance Show a => MimeRender PlainText a where mimeRender _ val = cs ("" <> show val)
+instance Accept SVG where contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
+instance MimeRender SVG SVG where mimeRender _ (SVG s) = DBL.fromStrict s
+instance MimeUnrender SVG SVG where mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
+instance Show SVG where show (SVG a) = show a
+instance ToSchema SVG where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
-instance ToSchema SVG
-  where
-    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
-
-instance Show SVG where
-  show (SVG a) = show a
+------------------------------------------------------------------------
+instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
-instance Accept SVG where
-   contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
+------------------------------------------------------------------------
 
-instance Show a => MimeRender PlainText a where
-   mimeRender _ val = cs ("" <> show val)
+data PhyloData = PhyloData { pd_corpusId :: NodeId
+                           , pd_listId   :: NodeId
+                           , pd_data     :: Value
+                           }
+  deriving (Generic)
 
-instance MimeRender SVG SVG where
-   mimeRender _ (SVG s) = DBL.fromStrict s
+instance FromJSON PhyloData
+instance ToJSON PhyloData
+instance ToSchema PhyloData
 
-------------------------------------------------------------------------
 type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "level"       Level
               :> QueryParam "minSizeBranch" MinSizeBranch
@@ -90,39 +95,64 @@ type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "display"    DisplayMode
               :> QueryParam "verbose"     Bool
     -}
-              :> Get '[SVG] SVG
+              -- :> Get '[SVG] SVG
+              :> Get '[JSON] PhyloData
+
 
 -- | TODO
 -- Add real text processing
 -- Fix Filter parameters
+-- TODO fix parameters to default config that should be in Node
 getPhylo :: PhyloId -> GargServer GetPhylo
-getPhylo phId _lId l msb  = do
-  phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
-  let
-    level = fromMaybe 2 l
-    branc = fromMaybe 2 msb
-    maybePhylo = phNode ^. (node_hyperdata . hp_data)
-
-  p <- liftBase $ viewPhylo2Svg
-                $ viewPhylo level branc
-                $ fromMaybe phyloFromQuery maybePhylo
-  pure (SVG p)
+getPhylo phyloId lId _level _minSizeBranch = do
+  corpusId <- fromMaybe (panic $ "[G.C.V.Phylo.API] no parent for NodeId " <> (cs $ show phyloId))
+          <$> getClosestParentIdByType phyloId NodeCorpus
+  listId   <- case lId of
+                Nothing -> defaultList corpusId
+                Just ld -> pure ld
+  theData <- getPhyloDataJson phyloId
+  -- printDebug "getPhylo" theData
+  pure $ PhyloData corpusId listId theData
+
+
+
+getPhyloDataJson :: PhyloId -> GargNoServer Value
+getPhyloDataJson phyloId = do
+  phyloData <- fromMaybe phyloExample <$> getPhyloData phyloId
+  phyloJson <- liftBase $ phylo2dot2json phyloData
+  pure phyloJson
+
+
+-- getPhyloDataSVG phId _lId l msb  = do
+  -- let
+  --   level = fromMaybe 2 l
+  --   branc = fromMaybe 2 msb
+  --   maybePhylo = phNode ^. (node_hyperdata . hp_data)
+
+  -- p <- liftBase $ viewPhylo2Svg
+  --               $ viewPhylo level branc
+  --               $ fromMaybe phyloFromQuery maybePhylo
+  -- pure (SVG p)
+
+
 ------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
                -- :> ReqBody '[JSON] PhyloQueryBuild
                :> (Post '[JSON] NodeId)
 
-postPhylo :: CorpusId -> UserId -> GargServer PostPhylo
-postPhylo corpusId userId _lId = do
+postPhylo :: PhyloId -> UserId -> GargServer PostPhylo
+postPhylo phyloId _userId _lId = do
   -- TODO get Reader settings
   -- s <- ask
   -- let
     -- _vrs = Just ("1" :: Text)
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
-  phy <- flowPhylo corpusId -- params
-  phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
-  pure $ NodeId (fromIntegral phyloId)
+  corpusId <- getClosestParentIdByType phyloId NodeCorpus
+  phy <- flowPhyloAPI defaultConfig (fromMaybe (panic "[G.C.V.P.API] no corpus ID found") corpusId) -- params
+  -- phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
+  _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
+  pure phyloId
 
 ------------------------------------------------------------------------
 -- | DELETE Phylo == delete a node
@@ -137,9 +167,9 @@ putPhylo = undefined
 
 
 -- | Instances
-instance Arbitrary Phylo             where arbitrary     = elements [phylo]
+-- instance Arbitrary Phylo             where arbitrary     = elements [phylo]
 instance Arbitrary PhyloGroup        where arbitrary     = elements []
-instance Arbitrary PhyloView         where arbitrary     = elements [phyloView]
+-- 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
@@ -158,4 +188,3 @@ instance ToParamSchema Order
 instance ToParamSchema Sort
 instance ToSchema Order
 
-