{-|
Module      : Gargantext.Database.Node.Document.Insert
Description : Importing context of texts (documents)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

* Purpose of this module

Enabling "common goods" of text data and respecting privacy.

Gargantext shares as "common good" the links between context of texts
and terms / words / ngrams.

Basically a context of text can be defined as a document (see 'Gargantext.Core.Text').

Issue to tackle in that module: each global document of Gargantext has
to be unique, then shared, but how to respect privacy if needed ?


* Methodology to get uniqueness and privacy by design

As a consequence, when importing/inserting a new document in Gargantext,
a policy for the uniqueness of the inserted docuemnts has to be defined.

That is the purpose of this module which defines its main concepts.

Unique identifier in database is of a 3-tuple of 3 policies that
together define uniqueness:

- Design policy: type of node is needed as TypenameId, that is a
Document or Individual or something else;

- Privacy policy: with ParentId, parent becomes unique, then it enables
users to get their own copy without sharing it with all the users of the
database (in others words parent_id is necessary to preserve privacy for
instance).

- Hash policy: this UniqId is a sha256 uniq id which is the result of
the concatenation of the parameters defined by @shaParameters@.

> -- * Example
> insertTest :: FromRow r => CorpusId -> [Node HyperdataDocument] -> IO [r]
> insertTest :: IO [ReturnId]
> insertTest = runCmdDev $ insertDocuments 1 452162 hyperdataDocuments

-}
------------------------------------------------------------------------
{-# LANGUAGE QuasiQuotes          #-}
{-# LANGUAGE TypeSynonymInstances #-}
------------------------------------------------------------------------
module Gargantext.Database.Query.Table.Node.Document.Insert
  where

import Control.Lens (set, view)
import Control.Lens.Cons
import Control.Lens.Prism
import Data.Aeson (toJSON, ToJSON)
import Data.Char (isAlpha)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
-- import Data.ByteString (ByteString)
import Data.Time.Segment (jour)
import Database.PostgreSQL.Simple (FromRow, Query, Only(..))
import Database.PostgreSQL.Simple.FromRow (fromRow, field)
-- import Database.PostgreSQL.Simple.ToRow (toRow, ToRow)
import Database.PostgreSQL.Simple.SqlQQ
import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import GHC.Generics (Generic)
import Gargantext.Core (HasDBid(toDBid))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
import Gargantext.Database.Schema.Node (NodePoly(..))
import qualified Gargantext.Defaults as Defaults
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import qualified Data.Text as DT (pack, concat, take, filter, toLower)

{-| To Print result query
import Data.ByteString.Internal (ByteString)
import Database.PostgreSQL.Simple (formatQuery)
-}

---------------------------------------------------------------------------
-- * Main Insert functions

-- | Insert Document main function
-- UserId : user who is inserting the documents
-- ParentId : folder ID which is parent of the inserted documents
-- Administrator of the database has to create a uniq index as following SQL command:
-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> Cmd err [ReturnId]
insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
      where
        fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

class InsertDb a
  where
    insertDb' :: HasDBid NodeType => UserId -> Maybe ParentId -> a -> [Action]


instance InsertDb HyperdataDocument
  where
    insertDb' u p h = [ toField ("" :: Text)
                      , toField $ toDBid NodeDocument
                      , toField u
                      , toField p
                      , toField $ maybe "No Title" (DT.take 255)  (_hd_title h)
                      , toField $ _hd_publication_date h -- TODO USE UTCTime
                      , (toField . toJSON) (addUniqId h)
                      ]

instance InsertDb HyperdataContact
  where
    insertDb' u p h = [ toField ("" :: Text)
                      , toField $ toDBid NodeContact
                      , toField u
                      , toField p
                      , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
                      , toField $ jour 0 1 1 -- TODO put default date
                      , (toField . toJSON) (addUniqId h)
                      ]

instance ToJSON a => InsertDb (Node a)
  where
    insertDb' _u _p (Node _nid hashId t u p n d h) = [ toField hashId
                                                     , toField t
                                                     , toField u
                                                     , toField p
                                                     , toField n
                                                     , toField d
                                                     , (toField . toJSON) h
                                                     ]

-- | Debug SQL function
--
-- to print rendered query (Debug purpose) use @formatQuery@ function.
{-
insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a, InsertDb [a])
                      => UserId -> ParentId -> [a] -> Cmd err ByteString
insertDocuments_Debug uId pId hs = formatPGSQuery queryInsert (Only $ Values fields inputData)
  where
    fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
    inputData = insertDb' uId pId hs
-}

-- | Input Tables: types of the tables
inputSqlTypes :: [Text]
inputSqlTypes = map DT.pack ["text", "int4","int4","int4","text","date","jsonb"]

-- | SQL query to insert documents inside the database
queryInsert :: Query
queryInsert = [sql|
    WITH input_rows(hash_id,typename,user_id,parent_id,name,date,hyperdata) AS (?)
    , ins AS (
       INSERT INTO contexts (hash_id, typename,user_id,parent_id,name,date,hyperdata)
       SELECT * FROM input_rows
       ON CONFLICT (hash_id) DO NOTHING -- on unique index -- this does not return the ids
       RETURNING id,hash_id
       )

    SELECT true AS source                     -- true for 'newly inserted'
         , id
         , hash_id
    FROM   ins
    UNION  ALL
    SELECT false AS source                    -- false for 'not inserted'
         , n.id
         , hash_id
    FROM   input_rows
    JOIN   contexts n USING (hash_id);         -- columns of unique index
           |]

------------------------------------------------------------------------
-- * Main Types used
-- ** Return Types

-- | When documents are inserted
-- ReturnType after insertion
data ReturnId = ReturnId { reInserted :: Bool -- if the document is inserted (True: is new, False: is not new)
                         , reId       :: NodeId  -- always return the id of the document (even new or not new)
                                         --   this is the uniq id in the database
                         , reUniqId   :: Text -- Hash Id with concatenation of sha parameters
                         } deriving (Show, Generic)

instance FromRow ReturnId where
  fromRow = ReturnId <$> field <*> field <*> field

---------------------------------------------------------------------------
-- * Uniqueness of document definition

class AddUniqId a
  where
    addUniqId :: a -> a

class UniqParameters a
  where
    uniqParameters :: ParentId -> a -> Text

instance AddUniqId HyperdataDocument
  where
    addUniqId = addUniqIdsDoc
      where
        addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
        addUniqIdsDoc doc = set hd_uniqIdBdd (Just shaBdd)
                          $ set hd_uniqId    (Just shaUni) doc
          where
            shaUni = hash $ DT.concat $ map ($ doc) shaParametersDoc
            shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc)

            shaParametersDoc :: [(HyperdataDocument -> Text)]
            shaParametersDoc = [ \d -> filterText $ maybeText (_hd_title            d)
                               , \d -> filterText $ maybeText (_hd_abstract         d)
                               , \d -> filterText $ maybeText (_hd_source           d)
                        --       , \d -> maybeText (_hd_publication_date d)
                               ]

instance UniqParameters HyperdataDocument
  where
    uniqParameters _ h = filterText $  DT.concat $ map maybeText $ [_hd_title h, _hd_abstract h, _hd_source h]

instance UniqParameters HyperdataContact
  where
    uniqParameters _ _ = ""

instance UniqParameters (Node a)
  where
    uniqParameters _ _ = undefined


filterText :: Text -> Text
filterText = DT.toLower . (DT.filter isAlpha)


instance (UniqParameters a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
  where
    addUniqId (Node nid _ t u p n d h)  = Node nid (Just newHash) t u p n d h
      where
        newHash = "\\x" <> (hash $ uniqParameters (fromMaybe 0 p) h)


    ---------------------------------------------------------------------------
-- * Uniqueness of document definition
-- TODO factorize with above (use the function below for tests)

instance AddUniqId HyperdataContact
  where
    addUniqId = addUniqIdsContact

addUniqIdsContact :: HyperdataContact -> HyperdataContact
addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
                     $ set (hc_uniqId   ) (Just shaUni) hc
  where
    shaUni = hash $ DT.concat $ map ($ hc) shaParametersContact
    shaBdd = hash $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> shaParametersContact)

    -- | TODO add more shaparameters
    shaParametersContact :: [(HyperdataContact -> Text)]
    shaParametersContact = [ \d -> maybeText $ view (hc_who   . _Just . cw_firstName              ) d
                           , \d -> maybeText $ view (hc_who   . _Just . cw_lastName               ) d
                           , \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
                           ]


maybeText :: Maybe Text -> Text
maybeText = maybe (DT.pack "") identity

---------------------------------------------------------------------------
class ToNode a
  where
    -- TODO Maybe NodeId
    toNode :: HasDBid NodeType => UserId -> Maybe ParentId -> a -> Node a

instance ToNode HyperdataDocument where
  toNode u p h = Node 0 Nothing (toDBid NodeDocument) u p n date h
    where
      n    = maybe "No Title" (DT.take 255) (_hd_title h)
      date  = jour y m d
      -- NOTE: There is no year '0' in postgres, there is year 1 AD and beofre that year 1 BC:
      -- select '0001-01-01'::date, '0001-01-01'::date - '1 day'::interval;
      -- 0001-01-01    0001-12-31 00:00:00 BC
      y = fromIntegral $ fromMaybe Defaults.day $ _hd_publication_year  h
      m = fromMaybe Defaults.month $ _hd_publication_month h
      d = fromMaybe (fromIntegral Defaults.year) $ _hd_publication_day   h

-- TODO better Node
instance ToNode HyperdataContact where
  toNode u p h = Node 0 Nothing (toDBid NodeContact) u p "Contact" date h
    where
      date  = jour 2020 01 01



