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

-}

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

{-# LANGUAGE TemplateHaskell       #-}

module Gargantext.Viz.Graph
  where


import Control.Lens (makeLenses)
import Data.Aeson.TH (deriveJSON)
import Data.ByteString.Lazy as DBL (readFile, writeFile)
import Data.Swagger
import Data.Text (Text, pack)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import GHC.Generics (Generic)
import GHC.IO (FilePath)
import Gargantext.Core.Types (ListId)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Viz.Graph.Distances (GraphMetric)
import Gargantext.Database.Prelude (fromField')
import Gargantext.Prelude
import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Data.Aeson as DA
import qualified Data.Text as T
import qualified Text.Read as T


data TypeNode = Terms | Unknown
  deriving (Show, Generic)

$(deriveJSON (unPrefix "") ''TypeNode)
instance ToSchema TypeNode

data Attributes = Attributes { clust_default :: Int }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''Attributes)
instance ToSchema Attributes

data Node = Node { node_size  :: Int
                 , node_type  :: TypeNode -- TODO NgramsType | Person
                 , node_id    :: Text     -- TODO NgramId
                 , node_label :: Text
                 , node_x_coord :: Double
                 , node_y_coord :: Double
                 , node_attributes :: Attributes
                 }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''Node)
instance ToSchema Node where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")


data Edge = Edge { edge_source :: Text
                 , edge_target :: Text
                 , edge_weight :: Double
                 , edge_confluence :: Double
                 , edge_id     :: Text
                 }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "edge_") ''Edge)
instance ToSchema Edge where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")

---------------------------------------------------------------
data LegendField = LegendField { _lf_id :: Int
                               , _lf_color :: Text
                               , _lf_label :: Text
   } deriving (Show, Generic)
$(deriveJSON (unPrefix "_lf_") ''LegendField)

instance ToSchema LegendField where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lf_")

makeLenses ''LegendField
---------------------------------------------------------------
type Version = Int
data ListForGraph =
  ListForGraph { _lfg_listId  :: ListId
               , _lfg_version :: Version
               } deriving (Show, Generic)
$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)

instance ToSchema ListForGraph where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lfg_")

makeLenses ''ListForGraph

--
data GraphMetadata =
  GraphMetadata { _gm_title    :: Text          -- title of the graph
                , _gm_metric   :: GraphMetric
                , _gm_corpusId :: [NodeId]      -- we can map with different corpus
                , _gm_legend   :: [LegendField] -- legend of the Graph
                , _gm_list     :: ListForGraph
                -- , _gm_version  :: Int
                }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
instance ToSchema GraphMetadata where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
makeLenses ''GraphMetadata


data Graph = Graph { _graph_nodes    :: [Node]
                   , _graph_edges    :: [Edge]
                   , _graph_metadata :: Maybe GraphMetadata
                   }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "_graph_") ''Graph)
makeLenses ''Graph

instance ToSchema Graph where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")

-- | Intances for the mack
instance Arbitrary Graph where
  arbitrary = elements $ [defaultGraph]

defaultGraph :: Graph
defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "16"}], _graph_metadata = Nothing}


-----------------------------------------------------------
-- V3 Gargantext Version

data AttributesV3 = AttributesV3 { cl :: Int }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''AttributesV3)

data NodeV3 = NodeV3 { no_id :: Int
                     , no_at :: AttributesV3
                     , no_s  :: Int
                     , no_lb :: Text
                     }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "no_") ''NodeV3)

data EdgeV3 = EdgeV3 { eo_s :: Int
                     , eo_t :: Int
                     , eo_w :: Text
                     }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "eo_") ''EdgeV3)

data GraphV3 = GraphV3 { go_links :: [EdgeV3]
                       , go_nodes :: [NodeV3]
                       }
  deriving (Show, Generic)
$(deriveJSON (unPrefix "go_") ''GraphV3)

-----------------------------------------------------------

data HyperdataGraph =
  HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
                 } deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''HyperdataGraph)

defaultHyperdataGraph :: HyperdataGraph 
defaultHyperdataGraph = HyperdataGraph Nothing


instance Hyperdata HyperdataGraph
makeLenses ''HyperdataGraph

instance FromField HyperdataGraph
  where
    fromField = fromField'

instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
  where
    queryRunnerColumnDefault = fieldQueryRunnerColumn

-----------------------------------------------------------

graphV3ToGraph :: GraphV3 -> Graph
graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links) Nothing
  where
    nodeV32node :: NodeV3 -> Node
    nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb')
                = Node no_s' Terms (cs $ show no_id') no_lb' 0 0 (Attributes cl')

    linkV32edge :: Int -> EdgeV3 -> Edge
    linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) 0.5 (cs $ show n)


graphV3ToGraphWithFiles :: FilePath -> FilePath -> IO ()
graphV3ToGraphWithFiles g1 g2 = do
  -- GraphV3 <- IO Fichier
  graph <- DBL.readFile g1
  let newGraph = case DA.decode graph :: Maybe GraphV3 of
        Nothing -> panic (T.pack "no graph")
        Just new -> new

  DBL.writeFile g2 (DA.encode $ graphV3ToGraph newGraph)

readGraphFromJson :: MonadBase IO m => FilePath -> m (Maybe Graph)
readGraphFromJson fp = do
  graph <- liftBase $ DBL.readFile fp
  pure $ DA.decode graph