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

-}



{-# LANGUAGE TemplateHaskell   #-}

-----------------------------------------------------------------------
module Gargantext.Core.Types.Main where
------------------------------------------------------------------------

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
import Data.Either (Either(..))
import Data.Hashable (Hashable)
import Data.Map (fromList, lookup)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(..))
import Data.Swagger
import Data.Text (Text, unpack)
import GHC.Generics (Generic)
import Gargantext.Core
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
import Gargantext.Prelude
import Servant.API (FromHttpApiData(..))
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Text.Read (read)

type CorpusName = Text
------------------------------------------------------------------------
data NodeTree = NodeTree { NodeTree -> Text
_nt_name :: Text
                         , NodeTree -> NodeType
_nt_type :: NodeType
                         , NodeTree -> NodeId
_nt_id   :: NodeId
                         } deriving (Int -> NodeTree -> ShowS
[NodeTree] -> ShowS
NodeTree -> String
(Int -> NodeTree -> ShowS)
-> (NodeTree -> String) -> ([NodeTree] -> ShowS) -> Show NodeTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeTree] -> ShowS
$cshowList :: [NodeTree] -> ShowS
show :: NodeTree -> String
$cshow :: NodeTree -> String
showsPrec :: Int -> NodeTree -> ShowS
$cshowsPrec :: Int -> NodeTree -> ShowS
Show, ReadPrec [NodeTree]
ReadPrec NodeTree
Int -> ReadS NodeTree
ReadS [NodeTree]
(Int -> ReadS NodeTree)
-> ReadS [NodeTree]
-> ReadPrec NodeTree
-> ReadPrec [NodeTree]
-> Read NodeTree
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeTree]
$creadListPrec :: ReadPrec [NodeTree]
readPrec :: ReadPrec NodeTree
$creadPrec :: ReadPrec NodeTree
readList :: ReadS [NodeTree]
$creadList :: ReadS [NodeTree]
readsPrec :: Int -> ReadS NodeTree
$creadsPrec :: Int -> ReadS NodeTree
Read, (forall x. NodeTree -> Rep NodeTree x)
-> (forall x. Rep NodeTree x -> NodeTree) -> Generic NodeTree
forall x. Rep NodeTree x -> NodeTree
forall x. NodeTree -> Rep NodeTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeTree x -> NodeTree
$cfrom :: forall x. NodeTree -> Rep NodeTree x
Generic)

$(deriveJSON (unPrefix "_nt_") ''NodeTree)
instance ToSchema NodeTree where
  declareNamedSchema :: Proxy NodeTree -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy NodeTree -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_nt_")
------------------------------------------------------------------------

--data Classification = Favorites | MyClassifcation

type TypeId     = Int
-- TODO multiple ListType declaration, remove it
-- data ListType  =  CandidateTerm | StopTerm | MapTerm
data ListType  =  CandidateTerm | StopTerm | MapTerm
  deriving ((forall x. ListType -> Rep ListType x)
-> (forall x. Rep ListType x -> ListType) -> Generic ListType
forall x. Rep ListType x -> ListType
forall x. ListType -> Rep ListType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListType x -> ListType
$cfrom :: forall x. ListType -> Rep ListType x
Generic, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq, Eq ListType
Eq ListType
-> (ListType -> ListType -> Ordering)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> ListType)
-> (ListType -> ListType -> ListType)
-> Ord ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmax :: ListType -> ListType -> ListType
>= :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c< :: ListType -> ListType -> Bool
compare :: ListType -> ListType -> Ordering
$ccompare :: ListType -> ListType -> Ordering
$cp1Ord :: Eq ListType
Ord, Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, ReadPrec [ListType]
ReadPrec ListType
Int -> ReadS ListType
ReadS [ListType]
(Int -> ReadS ListType)
-> ReadS [ListType]
-> ReadPrec ListType
-> ReadPrec [ListType]
-> Read ListType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListType]
$creadListPrec :: ReadPrec [ListType]
readPrec :: ReadPrec ListType
$creadPrec :: ReadPrec ListType
readList :: ReadS [ListType]
$creadList :: ReadS [ListType]
readsPrec :: Int -> ReadS ListType
$creadsPrec :: Int -> ReadS ListType
Read, Int -> ListType
ListType -> Int
ListType -> [ListType]
ListType -> ListType
ListType -> ListType -> [ListType]
ListType -> ListType -> ListType -> [ListType]
(ListType -> ListType)
-> (ListType -> ListType)
-> (Int -> ListType)
-> (ListType -> Int)
-> (ListType -> [ListType])
-> (ListType -> ListType -> [ListType])
-> (ListType -> ListType -> [ListType])
-> (ListType -> ListType -> ListType -> [ListType])
-> Enum ListType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ListType -> ListType -> ListType -> [ListType]
$cenumFromThenTo :: ListType -> ListType -> ListType -> [ListType]
enumFromTo :: ListType -> ListType -> [ListType]
$cenumFromTo :: ListType -> ListType -> [ListType]
enumFromThen :: ListType -> ListType -> [ListType]
$cenumFromThen :: ListType -> ListType -> [ListType]
enumFrom :: ListType -> [ListType]
$cenumFrom :: ListType -> [ListType]
fromEnum :: ListType -> Int
$cfromEnum :: ListType -> Int
toEnum :: Int -> ListType
$ctoEnum :: Int -> ListType
pred :: ListType -> ListType
$cpred :: ListType -> ListType
succ :: ListType -> ListType
$csucc :: ListType -> ListType
Enum, ListType
ListType -> ListType -> Bounded ListType
forall a. a -> a -> Bounded a
maxBound :: ListType
$cmaxBound :: ListType
minBound :: ListType
$cminBound :: ListType
Bounded)

instance ToJSON   ListType
instance FromJSON ListType
instance ToSchema ListType
instance ToParamSchema ListType
instance Arbitrary ListType where
  arbitrary :: Gen ListType
arbitrary = [ListType] -> Gen ListType
forall a. [a] -> Gen a
elements [ListType
forall a. Bounded a => a
minBound..ListType
forall a. Bounded a => a
maxBound]
instance Hashable ListType

instance Semigroup ListType
  where
    ListType
MapTerm  <> :: ListType -> ListType -> ListType
<> ListType
_             = ListType
MapTerm
    ListType
_        <> ListType
MapTerm       = ListType
MapTerm
    ListType
StopTerm <> ListType
_             = ListType
StopTerm
    ListType
_        <> ListType
StopTerm      = ListType
StopTerm
    ListType
_        <> ListType
_             = ListType
CandidateTerm


instance FromHttpApiData ListType where
  parseUrlPiece :: Text -> Either Text ListType
parseUrlPiece = ListType -> Either Text ListType
forall a b. b -> Either a b
Right (ListType -> Either Text ListType)
-> (Text -> ListType) -> Text -> Either Text ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ListType
forall a. Read a => String -> a
read (String -> ListType) -> (Text -> String) -> Text -> ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

type ListTypeId = Int

instance HasDBid ListType where
  toDBid :: ListType -> Int
toDBid   = ListType -> Int
listTypeId
  fromDBid :: Int -> ListType
fromDBid = (ListType -> Maybe ListType -> ListType
forall a. a -> Maybe a -> a
fromMaybe (Text -> ListType
forall a. HasCallStack => Text -> a
panic Text
"Instance HasDBid fromDBid ListType")) (Maybe ListType -> ListType)
-> (Int -> Maybe ListType) -> Int -> ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> Maybe ListType
fromListTypeId

-- FIXME Candidate: 0 and Stop : 1
listTypeId :: ListType -> ListTypeId
listTypeId :: ListType -> Int
listTypeId ListType
StopTerm      = Int
0
listTypeId ListType
CandidateTerm = Int
1
listTypeId ListType
MapTerm       = Int
2

fromListTypeId :: ListTypeId -> Maybe ListType
fromListTypeId :: Int -> Maybe ListType
fromListTypeId Int
i = Int -> Map Int ListType -> Maybe ListType
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
i
                 (Map Int ListType -> Maybe ListType)
-> Map Int ListType -> Maybe ListType
forall a b. (a -> b) -> a -> b
$ [(Int, ListType)] -> Map Int ListType
forall k a. Ord k => [(k, a)] -> Map k a
fromList
                 [ (ListType -> Int
listTypeId ListType
l, ListType
l)
                 | ListType
l <- [ListType
StopTerm, ListType
CandidateTerm, ListType
MapTerm]
                 ]

-- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
--              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal

-- | Community Manager Use Case
-- | Favorites Node enable Swap Node with some synonyms for clarity

-- | Then a Node can be a List which has some synonyms

-- | Then a Node can be a Score which has some synonyms

-- Queries
type Limit    = Int
type Offset   = Int
type IsTrash  = Bool

------------------------------------------------------------------------
-- All the Database is structured as a hierarchical Tree
data Tree a = TreeN { Tree a -> a
_tn_node :: a, Tree a -> [Tree a]
_tn_children :: [Tree a] }
  deriving (Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show, ReadPrec [Tree a]
ReadPrec (Tree a)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (Tree a)
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree a]
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readPrec :: ReadPrec (Tree a)
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readList :: ReadS [Tree a]
$creadList :: forall a. Read a => ReadS [Tree a]
readsPrec :: Int -> ReadS (Tree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
Read, Tree a -> Tree a -> Bool
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
Eq, (forall x. Tree a -> Rep (Tree a) x)
-> (forall x. Rep (Tree a) x -> Tree a) -> Generic (Tree a)
forall x. Rep (Tree a) x -> Tree a
forall x. Tree a -> Rep (Tree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tree a) x -> Tree a
forall a x. Tree a -> Rep (Tree a) x
$cto :: forall a x. Rep (Tree a) x -> Tree a
$cfrom :: forall a x. Tree a -> Rep (Tree a) x
Generic, Eq (Tree a)
Eq (Tree a)
-> (Tree a -> Tree a -> Ordering)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Tree a)
-> (Tree a -> Tree a -> Tree a)
-> Ord (Tree a)
Tree a -> Tree a -> Bool
Tree a -> Tree a -> Ordering
Tree a -> Tree a -> Tree a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Tree a)
forall a. Ord a => Tree a -> Tree a -> Bool
forall a. Ord a => Tree a -> Tree a -> Ordering
forall a. Ord a => Tree a -> Tree a -> Tree a
min :: Tree a -> Tree a -> Tree a
$cmin :: forall a. Ord a => Tree a -> Tree a -> Tree a
max :: Tree a -> Tree a -> Tree a
$cmax :: forall a. Ord a => Tree a -> Tree a -> Tree a
>= :: Tree a -> Tree a -> Bool
$c>= :: forall a. Ord a => Tree a -> Tree a -> Bool
> :: Tree a -> Tree a -> Bool
$c> :: forall a. Ord a => Tree a -> Tree a -> Bool
<= :: Tree a -> Tree a -> Bool
$c<= :: forall a. Ord a => Tree a -> Tree a -> Bool
< :: Tree a -> Tree a -> Bool
$c< :: forall a. Ord a => Tree a -> Tree a -> Bool
compare :: Tree a -> Tree a -> Ordering
$ccompare :: forall a. Ord a => Tree a -> Tree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Tree a)
Ord)

$(deriveJSON (unPrefix "_tn_") ''Tree)

instance (Typeable a, ToSchema a) => ToSchema (Tree a) where
  declareNamedSchema :: Proxy (Tree a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Text -> Proxy (Tree a) -> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, Generic a, GToSchema (Rep a),
 GenericHasSimpleShape
   a
   "genericDeclareNamedSchemaUnrestricted"
   (GenericShape (Rep a))) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
wellNamedSchema Text
"_tn_"

instance Arbitrary (Tree NodeTree) where
  arbitrary :: Gen (Tree NodeTree)
arbitrary = [Tree NodeTree] -> Gen (Tree NodeTree)
forall a. [a] -> Gen a
elements [Tree NodeTree
userTree, Tree NodeTree
userTree]


-- data Tree a = NodeT a [Tree a]
-- same as Data.Tree
leafT :: a -> Tree a
leafT :: a -> Tree a
leafT a
x = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
TreeN a
x []

------------------------------------------------------------------------
-- Garg Network is a network of all Garg nodes
--gargNetwork = undefined

-- | Garg Node is Database Schema Typed as specification
-- gargNode gathers all the Nodes of all users on one Node
gargNode :: [Tree NodeTree]
gargNode :: [Tree NodeTree]
gargNode = [Tree NodeTree
userTree]

-- | User Tree simplified
userTree :: Tree NodeTree
userTree :: Tree NodeTree
userTree = NodeTree -> [Tree NodeTree] -> Tree NodeTree
forall a. a -> [Tree a] -> Tree a
TreeN (Text -> NodeType -> NodeId -> NodeTree
NodeTree Text
"user name" NodeType
NodeUser NodeId
1) [Tree NodeTree
annuaireTree, Tree NodeTree
projectTree]

-- | Project Tree
projectTree :: Tree NodeTree
projectTree :: Tree NodeTree
projectTree = NodeTree -> [Tree NodeTree] -> Tree NodeTree
forall a. a -> [Tree a] -> Tree a
TreeN (Text -> NodeType -> NodeId -> NodeTree
NodeTree Text
"Project CNRS/IMT" NodeType
NodeFolder NodeId
2) [NodeId -> Text -> Tree NodeTree
corpusTree NodeId
10 Text
"A", NodeId -> Text -> Tree NodeTree
corpusTree NodeId
20 Text
"B"]

-- | Corpus Tree
annuaireTree :: Tree NodeTree
annuaireTree :: Tree NodeTree
annuaireTree = (NodeTree -> Tree NodeTree
forall a. a -> Tree a
leafT (NodeTree -> Tree NodeTree) -> NodeTree -> Tree NodeTree
forall a b. (a -> b) -> a -> b
$ Text -> NodeType -> NodeId -> NodeTree
NodeTree Text
"Annuaire" NodeType
NodeAnnuaire NodeId
41)

corpusTree :: NodeId -> Text -> Tree NodeTree
corpusTree :: NodeId -> Text -> Tree NodeTree
corpusTree NodeId
nId Text
t  = NodeTree -> [Tree NodeTree] -> Tree NodeTree
forall a. a -> [Tree a] -> Tree a
TreeN (Text -> NodeType -> NodeId -> NodeTree
NodeTree (Text
"Corpus " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)  NodeType
NodeCorpus NodeId
nId) (  [ NodeTree -> Tree NodeTree
forall a. a -> Tree a
leafT (NodeTree -> Tree NodeTree) -> NodeTree -> Tree NodeTree
forall a b. (a -> b) -> a -> b
$ Text -> NodeType -> NodeId -> NodeTree
NodeTree Text
"Dashboard" NodeType
NodeDashboard (NodeId
nId NodeId -> NodeId -> NodeId
forall a. Num a => a -> a -> a
+NodeId
1)
                                                                         , NodeTree -> Tree NodeTree
forall a. a -> Tree a
leafT (NodeTree -> Tree NodeTree) -> NodeTree -> Tree NodeTree
forall a b. (a -> b) -> a -> b
$ Text -> NodeType -> NodeId -> NodeTree
NodeTree Text
"Graph" NodeType
NodeGraph (NodeId
nId NodeId -> NodeId -> NodeId
forall a. Num a => a -> a -> a
+NodeId
2)
                                                                         ]
--                                                      <> [ leafT $ NodeTree "My lists"  Lists    5]
--                          <> [ leafT (NodeTree "Metrics A" Metrics 6)  ]
--                          <> [ leafT (NodeTree "Class A" Classification 7)]
                          )