{-|
Module      : Gargantext.Core.Viz.Phylo.API
Description : Phylo API
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE OverloadedLists    #-}   -- allows to write Map and HashMap as lists
{-# LANGUAGE TypeOperators      #-}

module Gargantext.Core.Viz.Phylo.API
  where

import Data.Aeson
import Data.Aeson.Types (parseEither)
import Data.Swagger
import Data.Text qualified as T
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Viz qualified as Named
import Gargantext.API.Viz.Types
import Gargantext.Core.Types.Phylo (GraphData(..))
import Gargantext.Core.Viz.LegacyPhylo hiding (Phylo(..))
import Gargantext.Core.Viz.Phylo (PhyloConfig(..), defaultConfig, _phylo_param, _phyloParam_config)
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Database.Prelude
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.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)
import Web.HttpApiData (readTextData)

phyloAPI :: IsGargServer err env m => PhyloId -> Named.PhyloAPI (AsServerT m)
phyloAPI n = Named.PhyloAPI
  { getPhyloEp  = getPhylo n
  , postPhyloEp = postPhylo n
  }
        -- :<|> putPhylo  n
        -- :<|> deletePhylo  n

-- | TODO
-- Add real text processing
-- Fix Filter parameters
-- TODO fix parameters to default config that should be in Node
-- NOTE(adn) this is not DB-tx safe in regards to reads.
getPhylo :: IsGargServer err env m => PhyloId -> Named.GetPhylo (AsServerT m)
getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do
  corpusId <- maybe (nodeLookupError $ NodeParentDoesNotExist phyloId) pure
              =<< (runDBQuery $ getClosestParentIdByType phyloId NodeCorpus)
  listId   <- case lId of
                Nothing -> runDBQuery $ defaultList corpusId
                Just ld -> pure ld
  pd <- getPhyloDataJson phyloId
  -- printDebug "getPhylo" theData
  case pd of
    Nothing -> pure $ PhyloData corpusId listId Nothing Nothing
    Just (gd, phyloConfig) ->
      pure $ PhyloData corpusId listId (Just gd) (Just phyloConfig)



getPhyloDataJson :: PhyloId -> GargNoServer (Maybe (GraphData, PhyloConfig))
getPhyloDataJson phyloId = do
  phyloData <- runDBQuery $ getPhyloData phyloId
  phyloJson <- liftBase $ maybePhylo2dot2json phyloData
  case phyloJson of
    Nothing -> pure Nothing
    Just pj  ->
      case parseEither parseJSON pj of
        Left err -> panicTrace $ T.pack $ "[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: " <> err
        Right gd -> pure  $ Just (gd, phyloConfig phyloData)
  where
    phyloConfig phyloData = _phyloParam_config . _phylo_param $ fromMaybe (panicTrace "[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: no phylo data") phyloData


-- 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)


-- FIXME(adn) This handler mixes DB reads with updates outside of the same
-- transaction, due to the call to 'flowPhyloAPI' in the middle.
postPhylo :: IsGargServer err env m => PhyloId -> Named.PostPhylo (AsServerT m)
postPhylo phyloId = Named.PostPhylo $ \_lId -> do
  -- TODO get Reader settings
  -- s <- ask
  -- let
    -- _vrs = Just ("1" :: Text)
    -- _sft = Just (Software "Gargantext" "4")
    -- _prm = initPhyloParam vrs sft (Just q)
  corpusId <- runDBQuery $ getClosestParentIdByType phyloId NodeCorpus
  -- Being the first time we ask for the Phylo, there is no historical data
  -- available about computing time, so we pass 'Nothing'.
  phy <- flowPhyloAPI defaultConfig Nothing (fromMaybe (panicTrace "[G.C.V.P.API] no corpus ID found") corpusId) -- params
  -- phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
  _ <- runDBTx $ updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
  pure phyloId

------------------------------------------------------------------------
-- | DELETE Phylo == delete a node
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
type PutPhylo = (Put '[JSON] Phylo  )
--putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo
putPhylo :: PhyloId -> GargServer PutPhylo
putPhylo = undefined
-}


-- | Instances
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 ToParamSchema   ExportMode
instance ToParamSchema   Filiation
instance ToParamSchema   Tagger
instance ToParamSchema Metric
instance ToParamSchema Order
instance ToParamSchema Sort
instance ToSchema Order
